Brummel/MycLib
1
0
Fork 0
Code Issues 1 Pull Requests Actions Packages Projects 1 Releases Wiki Activity

Pipes and test scripts

Browse Source
This commit is contained in:
Michael Schimmel
2025-12-26 13:47:10 +01:00
parent 8b765487ae
commit 185f8273dd
23 changed files with 1477 additions and 572 deletions
Download Patch File Download Diff File Expand all files Collapse all files
ASTPlayground/MainForm.fmx
+6
View File
@@ -183,6 +183,12 @@ object Form1: TForm1
TabOrder = 24
OnChange = RTLListViewChange
end
object SaveTestBtn: TButton
Position.X = 24.000000000000000000
Position.Y = 479.000000000000000000
TabOrder = 26
Text = 'Save test'
end
end
object Panel2: TPanel
Align = Client
ASTPlayground/MainForm.pas
+3 -1
View File
@@ -44,7 +44,8 @@ uses
Myc.Ast.RTL,
Myc.Ast.Compiler.Macros,
// Editor Units
Myc.Fmx.AstEditor;
Myc.Fmx.AstEditor,
FMX.Menus;
type
// A test record
@@ -87,6 +88,7 @@ type
SaveUserLibButton: TButton;
RTLListView: TListView;
CompilerStageBox: TComboBox;
SaveTestBtn: TButton;
procedure InnerLambdaButtonClick(Sender: TObject);
procedure ClearButtonClick(Sender: TObject);
procedure CompilerStageBoxChange(Sender: TObject);
Src/AST/Myc.Ast.Compiler.Binder.pas
+3 -29
View File
@@ -13,7 +13,7 @@ uses
Myc.Ast.Scope,
Myc.Ast.Types,
Myc.Ast.Compiler.Binder.Upvalues,
Myc.Ast.Identities, // Wichtig für AsNamed
Myc.Ast.Identities,
Myc.Ast;
type
@@ -40,7 +40,6 @@ type
FBoxedDeclarations: THashSet<IVariableDeclarationNode>;
FLog: ICompilerLog;
// Counts lambdas encountered to determine if a lambda has nested children
FLambdaCounter: Integer;
function IsValidIdentifier(const Name: string): Boolean;
@@ -234,7 +233,7 @@ var
upvalueIndex: Integer;
identity: INamedIdentity;
begin
identity := Node.Identity.AsNamed; // Type-safe extraction of identity
identity := Node.Identity.AsNamed;
if Node.Address.Kind = akUnresolved then
begin
@@ -249,7 +248,6 @@ begin
if physAddr.ScopeDepth > 0 then
begin
upvalueIndex := CaptureUpvalue(physAddr);
// Recreate identifier using the SAME identity but new address
Result := TAst.Identifier(identity, TResolvedAddress.Create(akUpvalue, 0, upvalueIndex), TTypes.Unknown);
end
else
@@ -298,12 +296,8 @@ begin
else
newInit := nil;
// Recreate identifier with bound address using original identity
newIdent := TAst.Identifier(identIdentity, addr, TTypes.Unknown);
isBoxed := (FBoxedDeclarations <> nil) and FBoxedDeclarations.Contains(Node);
// Recreate variable decl using original identity
Result := TAst.VarDecl(Node.Identity, newIdent, newInit, TTypes.Unknown, isBoxed);
if Assigned(FFunctionRegistry) and (newInit <> nil) and (newInit.Kind = akLambdaExpression) then
@@ -356,7 +350,6 @@ begin
try
FCurrentBuilder.Define('<self>');
// Create Array to hold transformed parameters
SetLength(newParams, Node.Parameters.Count);
for i := 0 to Node.Parameters.Count - 1 do
@@ -383,7 +376,6 @@ begin
if (parentBuilder.Parent = nil) and (FArgTypes <> nil) and (i < Length(FArgTypes)) then
paramType := FArgTypes[i];
// Rebind parameter identifier using original identity
newParams[i] := TAst.Identifier(paramIdentity, addr, paramType);
end;
@@ -417,40 +409,22 @@ begin
hasNested := FLambdaCounter > (startCount + 1);
// Wrap the array in a List wrapper to satisfy the factory interface
// We reuse the identity of the old parameter list
paramList := TParameterList.Create(newParams, Node.Parameters.Identity);
// Rebuild Lambda using original identity
Result :=
TAst.LambdaExpr(
Node.Identity,
paramList,
newBody,
finalLayout,
nil, // Descriptor is created in TypeChecker
upvaluesList,
hasNested,
Node.IsPure
);
Result := TAst.LambdaExpr(Node.Identity, paramList, newBody, finalLayout, nil, upvaluesList, hasNested, Node.IsPure);
end;
function TAstBinder.VisitFunctionCall(const Node: IFunctionCallNode): IAstNode;
begin
if Node.Callee.Kind = akKeyword then
begin
// Transform keyword call (:key obj) into member access (.key obj)
// Check argument count
if Node.Arguments.Count <> 1 then
begin
if Assigned(FLog) then
FLog.AddError(Format('Keyword access :%s requires exactly one argument.', [Node.Callee.AsKeyword.Value.Name]), Node);
// Fallthrough to standard visit/recreation to avoid crash
end
else
begin
// Note: The new MemberAccess node gets the identity of the original FunctionCall
// The member keyword retains its own identity.
var memberAccess := TAst.MemberAccess(Node.Identity, Accept(Node.Arguments[0]), Node.Callee.AsKeyword);
Result := memberAccess;
exit;
Src/AST/Myc.Ast.Compiler.TypeChecker.pas
+324 -434
View File
@@ -60,19 +60,21 @@ type
function VisitFunctionCall(const Node: IFunctionCallNode): IAstNode; override;
function VisitBlockExpression(const Node: IBlockExpressionNode): IAstNode; override;
function VisitIfExpression(const Node: IIfExpressionNode): IAstNode; override;
function VisitCondExpression(const Node: ICondExpressionNode): IAstNode; override;
function VisitMemberAccess(const Node: IMemberAccessNode): IAstNode; override;
function VisitIndexer(const Node: IIndexerNode): IAstNode; override;
function VisitRecordLiteral(const Node: IRecordLiteralNode): IAstNode; override;
function VisitCreateSeries(const Node: ICreateSeriesNode): IAstNode; override;
function VisitAddSeriesItem(const Node: IAddSeriesItemNode): IAstNode; override;
function VisitSeriesLength(const Node: ISeriesLengthNode): IAstNode; override;
function VisitRecurNode(const Node: IRecurNode): IAstNode; override;
function VisitNop(const Node: INopNode): IAstNode; override;
function VisitRecordLiteral(const Node: IRecordLiteralNode): IAstNode; override;
function VisitConstant(const Node: IConstantNode): IAstNode; override;
function VisitKeyword(const Node: IKeywordNode): IAstNode; override;
// Pipe Support
function VisitPipeInput(const Node: IPipeInputNode): IAstNode; override;
function VisitPipe(const Node: IPipeNode): IAstNode; override;
public
constructor Create(const RootLayout: IScopeLayout; const RootScope: IExecutionScope; const ALog: ICompilerLog);
destructor Destroy; override;
@@ -183,8 +185,6 @@ begin
p := CreateContextChain(L.Parent);
desc := nil;
// Check if this layout is the root layout (has no parent).
// If so, attach the RootScope's descriptor to pull in RTL types (like +).
if (L.Parent = nil) and Assigned(FRootScope) then
begin
desc := FRootScope.Descriptor;
@@ -224,10 +224,6 @@ class function TTypeChecker.CheckTypes(
var
startLayout: IScopeLayout;
begin
// Determine the starting scope for the TypeChecker.
// The 'Layout' parameter represents the *inner* scope of the script (the "Room").
// To correctly simulate entering this scope (via VisitLambdaExpression), the TypeChecker
// must start in the *surrounding* scope (the "Hallway"), which is Layout.Parent.
if Assigned(Layout) then
startLayout := Layout.Parent
else
@@ -312,14 +308,9 @@ var
initType: IStaticType;
newInitializer, newIdent: IAstNode;
adr: TResolvedAddress;
lambdaNode: ILambdaExpressionNode;
placeholderType: IStaticType;
i: Integer;
identNode: IIdentifierNode;
identIdentity: INamedIdentity;
begin
identNode := Node.Target.AsIdentifier;
identIdentity := identNode.Identity.AsNamed;
adr := identNode.Address;
initType := TTypes.Unknown;
@@ -331,35 +322,18 @@ begin
Exit;
end;
placeholderType := nil;
if (Node.Initializer <> nil) and (Node.Initializer.Kind = akLambdaExpression) then
begin
lambdaNode := Node.Initializer.AsLambdaExpression;
var paramTypes: TArray<IStaticType>;
SetLength(paramTypes, lambdaNode.Parameters.Count);
for i := 0 to High(paramTypes) do
paramTypes[i] := TTypes.Unknown;
placeholderType := TTypes.CreateMethod(paramTypes, TTypes.Unknown);
FCurrentContext.SetType(adr.SlotIndex, placeholderType);
initType := placeholderType;
end;
if Assigned(Node.Initializer) then
newInitializer := Accept(Node.Initializer)
else
newInitializer := nil;
if Assigned(newInitializer) then
initType := newInitializer.AsTypedNode.StaticType
else if not Assigned(placeholderType) then
initType := TTypes.Unknown;
initType := newInitializer.AsTypedNode.StaticType;
if initType.Kind <> stUnknown then
FCurrentContext.SetType(adr.SlotIndex, initType);
newIdent := TAst.Identifier(identIdentity, adr, initType);
newIdent := TAst.Identifier(identNode.Identity.AsNamed, adr, initType);
Result := TAst.VarDecl(Node.Identity, newIdent, newInitializer, initType, Node.IsBoxed);
end;
@@ -368,15 +342,9 @@ var
targetType, sourceType: IStaticType;
newIdent, newValue: IAstNode;
adr: TResolvedAddress;
lambdaNode: ILambdaExpressionNode;
placeholderType: IStaticType;
i: Integer;
identNode: IIdentifierNode;
identIdentity: INamedIdentity;
begin
identNode := Node.Target.AsIdentifier;
identIdentity := identNode.Identity.AsNamed;
newIdent := Accept(Node.Target);
targetType := newIdent.AsTypedNode.StaticType;
adr := identNode.Address;
@@ -388,23 +356,6 @@ begin
Exit;
end;
placeholderType := nil;
if (Node.Value <> nil) and (Node.Value.Kind = akLambdaExpression) then
begin
lambdaNode := Node.Value.AsLambdaExpression;
if (targetType.Kind <> stMethod) then
begin
var paramTypes: TArray<IStaticType>;
SetLength(paramTypes, lambdaNode.Parameters.Count);
for i := 0 to High(paramTypes) do
paramTypes[i] := TTypes.Unknown;
placeholderType := TTypes.CreateMethod(paramTypes, TTypes.Unknown);
FCurrentContext.SetType(adr.SlotIndex, placeholderType);
targetType := placeholderType;
end;
end;
newValue := Accept(Node.Value);
sourceType := newValue.AsTypedNode.StaticType;
@@ -417,16 +368,35 @@ begin
end;
end;
if ((targetType.Kind = stUnknown) or Assigned(placeholderType)) and (sourceType.Kind <> stUnknown) then
if (targetType.Kind = stUnknown) and (sourceType.Kind <> stUnknown) then
begin
FCurrentContext.SetType(adr.SlotIndex, sourceType);
newIdent := TAst.Identifier(identIdentity, adr, sourceType);
newIdent := TAst.Identifier(identNode.Identity.AsNamed, adr, sourceType);
targetType := sourceType;
end;
Result := TAst.Assign(Node.Identity, newIdent, newValue, targetType);
end;
function TTypeChecker.VisitBlockExpression(const Node: IBlockExpressionNode): IAstNode;
var
blockType: IStaticType;
newExprs: TArray<IAstNode>;
i: Integer;
begin
SetLength(newExprs, Node.Expressions.Count);
for i := 0 to Node.Expressions.Count - 1 do
newExprs[i] := Accept(Node.Expressions[i]);
if Length(newExprs) > 0 then
blockType := newExprs[High(newExprs)].AsTypedNode.StaticType
else
blockType := TTypes.Void;
var exprList := TExpressionList.Create(newExprs, Node.Expressions.Identity);
Result := TAst.Block(Node.Identity, exprList, blockType);
end;
function TTypeChecker.VisitLambdaExpression(const Node: ILambdaExpressionNode): IAstNode;
var
newParams: TArray<IIdentifierNode>;
@@ -434,72 +404,57 @@ var
bodyType, methodType: IStaticType;
paramTypes: TArray<IStaticType>;
upvalueTypes: TArray<IStaticType>;
upvalueAddrs: TArray<TResolvedAddress>;
i: Integer;
finalDescriptor: IScopeDescriptor;
paramIdent: IIdentifierNode;
paramIdentity: INamedIdentity;
lookupAddr: TResolvedAddress;
injectedType: IStaticType;
begin
// 1. Resolve Upvalue Types
upvalueAddrs := Node.Upvalues;
var upvalueAddrs := Node.Upvalues;
SetLength(upvalueTypes, Length(upvalueAddrs));
for i := 0 to High(upvalueAddrs) do
begin
lookupAddr := upvalueAddrs[i];
// CRITICAL: Scope Depth Adjustment
// The Binder calculated addresses relative to the *body* of this lambda (Internal View).
// FCurrentContext currently points to the *defining* scope (External View/Parent).
// Therefore, we must decrease the depth by 1 to look up the type in the current context.
var lookupAddr := upvalueAddrs[i];
if lookupAddr.Kind = akLocalOrParent then
begin
// Check > 0 to prevent crash if Binder somehow produced 0 (though logic says it shouldn't).
if lookupAddr.ScopeDepth > 0 then
Dec(lookupAddr.ScopeDepth)
else
begin
// Guard for Binder quirks or edge cases
if Assigned(FLog) then
FLog.AddWarning('Compiler integrity check warning: Upvalue Depth 0 encountered during type check.', Node);
Dec(lookupAddr.ScopeDepth);
end;
end;
upvalueTypes[i] := FCurrentContext.LookupType(lookupAddr);
end;
// 2. Enter New Scope (The "Room")
// 2. Enter New Scope
FCurrentContext := TTypeContext.Create(FCurrentContext, Node.Layout, upvalueTypes, nil);
try
// 3. Register Parameters
SetLength(newParams, Node.Parameters.Count);
SetLength(paramTypes, Node.Parameters.Count);
for i := 0 to Node.Parameters.Count - 1 do
begin
paramIdent := Node.Parameters[i];
paramIdentity := paramIdent.Identity.AsNamed;
var paramAdr := paramIdent.Address;
paramTypes[i] := TTypes.Unknown;
// Check if there is already a type assigned (e.g. injected by Pipe Visitor)
injectedType := paramIdent.AsTypedNode.StaticType;
if paramAdr.Kind <> akUnresolved then
FCurrentContext.SetType(paramAdr.SlotIndex, paramTypes[i]);
if injectedType.Kind = stUnknown then
paramTypes[i] := TTypes.Unknown
else
paramTypes[i] := injectedType;
newParams[i] := TAst.Identifier(paramIdentity, paramAdr, paramTypes[i]);
if paramIdent.Address.Kind <> akUnresolved then
FCurrentContext.SetType(paramIdent.Address.SlotIndex, paramTypes[i]);
newParams[i] := TAst.Identifier(paramIdent.Identity.AsNamed, paramIdent.Address, paramTypes[i]);
end;
// 4. Visit Body
newBody := Accept(Node.Body);
// 5. Determine Function Signature
bodyType := newBody.AsTypedNode.StaticType;
methodType := TTypes.CreateMethod(paramTypes, bodyType);
finalDescriptor := TScope.CreateDescriptor(Node.Layout, FCurrentContext.Types);
finally
// 6. Leave Scope
var temp := FCurrentContext;
FCurrentContext := FCurrentContext.FParent;
temp.Free;
@@ -529,15 +484,13 @@ var
argTypes: TArray<IStaticType>;
hasUnknownArgs: Boolean;
bestSig: IMethodSignature;
sig: IMethodSignature;
match: Boolean;
argsStr: string;
begin
newCallee := Accept(Node.Callee);
SetLength(newArgs, Node.Arguments.Count);
SetLength(argTypes, Node.Arguments.Count);
hasUnknownArgs := False;
for i := 0 to Node.Arguments.Count - 1 do
begin
newArgs[i] := Accept(Node.Arguments[i]);
@@ -549,26 +502,22 @@ begin
calleeType := newCallee.AsTypedNode.StaticType;
retType := TTypes.Unknown;
if calleeType.Kind = TStaticTypeKind.stMethod then
if calleeType.Kind = stMethod then
begin
if not hasUnknownArgs then
begin
bestSig := nil;
for sig in calleeType.Signatures do
for var sig in calleeType.Signatures do
begin
if Length(sig.ParamTypes) <> Length(argTypes) then
continue;
match := True;
for j := 0 to High(argTypes) do
begin
if not TTypeRules.CanAssign(sig.ParamTypes[j], argTypes[j]) then
begin
match := False;
break;
end;
end;
if match then
begin
bestSig := sig;
@@ -578,389 +527,179 @@ begin
if Assigned(bestSig) then
retType := bestSig.ReturnType
else
begin
if Assigned(FLog) then
begin
argsStr := '';
for i := 0 to High(argTypes) do
argsStr := argsStr + argTypes[i].ToString + ' ';
FLog.AddError(
Format('No matching signature for call with args (%s) found on method %s', [argsStr, calleeType.ToString]),
Node
);
end;
retType := TTypes.Unknown;
end;
else if Assigned(FLog) then
FLog.AddError(Format('No matching signature found for method call on %s', [calleeType.ToString]), Node);
end;
end
else if calleeType.Kind <> TStaticTypeKind.stUnknown then
begin
else if calleeType.Kind <> stUnknown then
if Assigned(FLog) then
FLog.AddError(Format('Cannot invoke type %s as a function.', [calleeType.ToString]), Node);
retType := TTypes.Unknown;
end;
var argList := TArgumentList.Create(newArgs, Node.Arguments.Identity);
Result := TAst.FunctionCall(Node.Identity, newCallee, argList, retType, Node.IsTailCall, nil, False);
end;
function TTypeChecker.VisitBlockExpression(const Node: IBlockExpressionNode): IAstNode;
var
blockType: IStaticType;
newExprs: TArray<IAstNode>;
i: Integer;
begin
SetLength(newExprs, Node.Expressions.Count);
for i := 0 to Node.Expressions.Count - 1 do
newExprs[i] := Accept(Node.Expressions[i]);
if Length(newExprs) > 0 then
blockType := newExprs[High(newExprs)].AsTypedNode.StaticType
else
blockType := TTypes.Void;
var exprList := TExpressionList.Create(newExprs, Node.Expressions.Identity);
Result := TAst.Block(Node.Identity, exprList, blockType);
end;
function TTypeChecker.VisitIfExpression(const Node: IIfExpressionNode): IAstNode;
var
conditionType, thenType, elseType, resultType: IStaticType;
newCond, newThen, newElse: IAstNode;
resType: IStaticType;
begin
newCond := Accept(Node.Condition);
newThen := Accept(Node.ThenBranch);
newElse := Accept(Node.ElseBranch);
conditionType := newCond.AsTypedNode.StaticType;
if (conditionType.Kind <> stUnknown)
and not TTypeRules.CanAssign(TTypes.Ordinal, conditionType)
and not TTypeRules.CanAssign(TTypes.Boolean, conditionType) then
begin
if Assigned(FLog) then
FLog.AddError(Format('If condition must be Boolean or Ordinal, but got %s', [conditionType.ToString]), Node);
end;
thenType := newThen.AsTypedNode.StaticType;
elseType :=
if newElse <> nil then newElse.AsTypedNode.StaticType
else TTypes.Void;
resultType := TTypeRules.Promote(thenType, elseType);
if resultType = nil then
begin
if Assigned(FLog) then
FLog.AddError(Format('Cannot promote types %s and %s in If-Expression', [thenType.ToString, elseType.ToString]), Node);
resultType := TTypes.Unknown;
end;
Result := TAst.IfExpr(Node.Identity, newCond, newThen, newElse, resultType);
end;
function TTypeChecker.VisitCondExpression(const Node: ICondExpressionNode): IAstNode;
var
i: Integer;
newPairs: TArray<TCondPair>;
newElse: IAstNode;
condType, branchType, resultType: IStaticType;
begin
SetLength(newPairs, Length(Node.Pairs));
resultType := nil;
for i := 0 to High(Node.Pairs) do
begin
var newCond := Accept(Node.Pairs[i].Condition);
condType := newCond.AsTypedNode.StaticType;
if (condType.Kind <> stUnknown)
and not TTypeRules.CanAssign(TTypes.Ordinal, condType)
and not TTypeRules.CanAssign(TTypes.Boolean, condType) then
begin
if Assigned(FLog) then
FLog.AddError(Format('Cond condition must be Boolean or Ordinal, but got %s', [condType.ToString]), Node);
end;
var newBranch := Accept(Node.Pairs[i].Branch);
branchType := newBranch.AsTypedNode.StaticType;
newPairs[i] := TCondPair.Create(newCond, newBranch);
if resultType = nil then
resultType := branchType
// Simple promotion logic
if (newElse <> nil) then
resType := TTypeRules.Promote(newThen.AsTypedNode.StaticType, newElse.AsTypedNode.StaticType)
else
begin
var promoted := TTypeRules.Promote(resultType, branchType);
if promoted = nil then
begin
if Assigned(FLog) then
FLog.AddError(
Format('Incompatible types in Cond branches: %s and %s', [resultType.ToString, branchType.ToString]),
Node
);
resultType := TTypes.Unknown;
end
else
resultType := promoted;
end;
end;
resType := TTypes.MakeOptional(newThen.AsTypedNode.StaticType);
newElse := Accept(Node.ElseBranch);
var elseType := newElse.AsTypedNode.StaticType;
if resultType = nil then
resultType := elseType
else
begin
var promoted := TTypeRules.Promote(resultType, elseType);
if promoted = nil then
begin
if Assigned(FLog) then
FLog.AddError(
Format('Incompatible types in Cond branches (Else): %s and %s', [resultType.ToString, elseType.ToString]),
Node
);
resultType := TTypes.Unknown;
end
else
resultType := promoted;
end;
Result := TAst.CondExpr(Node.Identity, newPairs, newElse, resultType);
end;
function TTypeChecker.VisitMemberAccess(const Node: IMemberAccessNode): IAstNode;
var
unwrappedBaseType, elemType: IStaticType;
fieldIndex: Integer;
newBase, newMember: IAstNode;
isOptionalAccess: Boolean;
begin
newBase := Accept(Node.Base);
newMember := Accept(Node.Member);
unwrappedBaseType := PrepareBaseType(newBase, isOptionalAccess);
elemType := TTypes.Unknown;
if (unwrappedBaseType.Kind <> TStaticTypeKind.stUnknown) then
begin
if (unwrappedBaseType.Kind = TStaticTypeKind.stRecord) or (unwrappedBaseType.Kind = TStaticTypeKind.stRecordSeries) then
begin
fieldIndex := unwrappedBaseType.Definition.IndexOf(Node.Member.Value);
if fieldIndex < 0 then
begin
if Assigned(FLog) then
FLog.AddError(Format('Member "%s" not found in type %s', [Node.Member.Value.Name, unwrappedBaseType.ToString]), Node);
end
else
begin
var fieldType := TTypes.FromScalarKind(unwrappedBaseType.Definition[fieldIndex].Value);
if unwrappedBaseType.Kind = TStaticTypeKind.stRecord then
elemType := fieldType
else
elemType := TTypes.CreateSeries(fieldType);
end;
end
else if (unwrappedBaseType.Kind = TStaticTypeKind.stGenericRecord) then
begin
var genDef := unwrappedBaseType.GenericDefinition;
fieldIndex := genDef.IndexOf(Node.Member.Value);
if fieldIndex < 0 then
begin
if Assigned(FLog) then
FLog.AddError(Format('Member "%s" not found in type %s', [Node.Member.Value.Name, unwrappedBaseType.ToString]), Node);
end
else
elemType := genDef[fieldIndex].Value;
end
else
begin
if Assigned(FLog) then
FLog.AddError(Format('Member access requires a record type, but got %s', [unwrappedBaseType.ToString]), Node);
end;
end;
elemType := ApplyOptionality(elemType, isOptionalAccess);
Result := TAst.MemberAccess(Node.Identity, newBase, newMember.AsKeyword, elemType);
Result := TAst.IfExpr(Node.Identity, newCond, newThen, newElse, resType);
end;
function TTypeChecker.VisitIndexer(const Node: IIndexerNode): IAstNode;
var
unwrappedBaseType, indexType, elemType: IStaticType;
newBase, newIndex: IAstNode;
isOptionalAccess: Boolean;
baseType, elemType: IStaticType;
isOpt: Boolean;
begin
newBase := Accept(Node.Base);
newIndex := Accept(Node.Index);
baseType := PrepareBaseType(newBase, isOpt);
unwrappedBaseType := PrepareBaseType(newBase, isOptionalAccess);
indexType := newIndex.AsTypedNode.StaticType;
elemType := TTypes.Unknown;
if baseType.Kind = stSeries then
elemType := baseType.ElementType
else if baseType.Kind = stRecordSeries then
elemType := TTypes.CreateRecord(baseType.Definition);
if (unwrappedBaseType.Kind <> TStaticTypeKind.stUnknown) then
begin
if (unwrappedBaseType.Kind <> TStaticTypeKind.stSeries) and (unwrappedBaseType.Kind <> TStaticTypeKind.stRecordSeries) then
begin
if Assigned(FLog) then
FLog.AddError(Format('Indexer `[]` can only be applied to series types, but got %s', [unwrappedBaseType.ToString]), Node);
end
else
begin
if unwrappedBaseType.Kind = TStaticTypeKind.stSeries then
elemType := unwrappedBaseType.ElementType
else
elemType := TTypes.CreateRecord(unwrappedBaseType.Definition);
end;
end;
if (indexType.Kind <> stUnknown) and not TTypeRules.CanAssign(TTypes.Ordinal, indexType) then
begin
if Assigned(FLog) then
FLog.AddError(Format('Indexer `[]` requires an Ordinal index, but got %s', [indexType.ToString]), Node);
end;
elemType := ApplyOptionality(elemType, isOptionalAccess);
elemType := ApplyOptionality(elemType, isOpt);
Result := TAst.Indexer(Node.Identity, newBase, newIndex, elemType);
end;
function TTypeChecker.VisitMemberAccess(const Node: IMemberAccessNode): IAstNode;
var
newBase: IAstNode;
baseType, resType: IStaticType;
idx: Integer;
isOpt: Boolean;
begin
newBase := Accept(Node.Base);
baseType := PrepareBaseType(newBase, isOpt);
resType := TTypes.Unknown;
if (baseType.Kind = stRecord) or (baseType.Kind = stRecordSeries) then
begin
idx := baseType.Definition.IndexOf(Node.Member.Value);
if idx >= 0 then
begin
var fieldType := TTypes.FromScalarKind(baseType.Definition.Items[idx].Value);
if baseType.Kind = stRecordSeries then
resType := TTypes.CreateSeries(fieldType)
else
resType := fieldType;
end
else if Assigned(FLog) then
FLog.AddError('Member not found', Node);
end;
resType := ApplyOptionality(resType, isOpt);
Result := TAst.MemberAccess(Node.Identity, newBase, Node.Member, resType);
end;
function TTypeChecker.VisitRecordLiteral(const Node: IRecordLiteralNode): IAstNode;
var
i: Integer;
scalarDefFields: TArray<TScalarRecordField>;
def: IScalarRecordDefinition;
staticType: IStaticType;
valType: IStaticType;
scalarKind: TScalar.TKind;
allScalar: Boolean;
newFields: TArray<IRecordFieldNode>;
fieldTypes: TArray<TPair<IKeyword, IStaticType>>;
scalarFieldTypes: TArray<TPair<IKeyword, TScalar.TKind>>;
isScalar: Boolean;
valType: IStaticType;
key: IKeyword;
visitedValue: IAstNode;
newFieldList: IRecordFieldList;
begin
SetLength(newFields, Node.Fields.Count);
SetLength(fieldTypes, Node.Fields.Count);
SetLength(scalarFieldTypes, Node.Fields.Count);
isScalar := True;
for i := 0 to Node.Fields.Count - 1 do
begin
var field := Node.Fields[i];
var newKey := Accept(field.Key).AsKeyword;
var newValue := Accept(field.Value);
var oldField := Node.Fields[i];
visitedValue := Accept(oldField.Value);
if (newKey = field.Key) and (newValue = field.Value) then
newFields[i] := field
// Keys are guaranteed to be keywords by parser
key := oldField.Key.Value;
// Recreate the field node with the typed value
newFields[i] := TAst.RecordField(oldField.Identity, oldField.Key, visitedValue);
// Analyze Type
valType := visitedValue.AsTypedNode.StaticType;
// Check if strict scalar (no optionals allowed in packed ScalarRecord)
if (valType.Kind in [stOrdinal, stFloat, stBoolean, stDateTime, stKeyword]) and (not valType.IsOptional) then
begin
var kind: TScalar.TKind;
// Map StaticType Kind to Scalar Kind
case valType.Kind of
stOrdinal: kind := TScalar.TKind.Ordinal;
stFloat: kind := TScalar.TKind.Float;
stBoolean: kind := TScalar.TKind.Boolean;
stDateTime: kind := TScalar.TKind.DateTime;
stKeyword: kind := TScalar.TKind.Keyword;
else
newFields[i] := TAst.RecordField(field.Identity, newKey, newValue);
kind := TScalar.TKind.Ordinal; // Should not happen given check above
end;
SetLength(scalarDefFields, Length(newFields));
allScalar := True;
for i := 0 to High(newFields) do
begin
valType := newFields[i].Value.AsTypedNode.StaticType;
if (valType.Kind = stOrdinal) then
scalarKind := TScalar.TKind.Ordinal
else if (valType.Kind = stFloat) then
scalarKind := TScalar.TKind.Float
else if (valType.Kind = stKeyword) then
scalarKind := TScalar.TKind.Keyword
else if (valType.Kind = stBoolean) then
scalarKind := TScalar.TKind.Boolean
else if (valType.Kind = stDateTime) then
scalarKind := TScalar.TKind.DateTime
else
begin
allScalar := False;
scalarKind := TScalar.TKind.Ordinal;
end;
if allScalar then
scalarDefFields[i] := TScalarRecordField.Create(newFields[i].Key.Value, scalarKind);
end;
var fieldList := TRecordFieldList.Create(newFields, Node.Fields.Identity);
if allScalar then
begin
def := TScalarRecord.TRegistry.Intern(scalarDefFields);
staticType := TTypes.CreateRecord(def);
Result := TAst.RecordLiteral(Node.Identity, fieldList, def, nil, staticType);
scalarFieldTypes[i] := TPair<IKeyword, TScalar.TKind>.Create(key, kind);
end
else
begin
var genDefFields: TArray<TPair<IKeyword, IStaticType>>;
SetLength(genDefFields, Length(newFields));
for i := 0 to High(newFields) do
genDefFields[i] := TPair<IKeyword, IStaticType>.Create(newFields[i].Key.Value, newFields[i].Value.AsTypedNode.StaticType);
var genDef := TGenericRecordRegistry.Intern(genDefFields);
staticType := TTypes.CreateGenericRecord(genDef);
Result := TAst.RecordLiteral(Node.Identity, fieldList, nil, genDef, staticType);
isScalar := False;
end;
fieldTypes[i] := TPair<IKeyword, IStaticType>.Create(key, valType);
end;
// Build Definition
var scalarDef: IScalarRecordDefinition := nil;
var genericDef: IGenericRecordDefinition := nil;
var resultType: IStaticType;
if isScalar and (Length(newFields) > 0) then
begin
scalarDef := TKeywordMappingRegistry<TScalar.TKind>.Intern(scalarFieldTypes);
resultType := TTypes.CreateRecord(scalarDef);
end
else
begin
genericDef := TGenericRecordRegistry.Intern(fieldTypes);
resultType := TTypes.CreateGenericRecord(genericDef);
end;
newFieldList := TRecordFieldList.Create(newFields, Node.Fields.Identity);
Result := TAst.RecordLiteral(Node.Identity, newFieldList, scalarDef, genericDef, resultType);
end;
function TTypeChecker.VisitCreateSeries(const Node: ICreateSeriesNode): IAstNode;
var
elemType: IStaticType;
defIdentity: IDefinitionIdentity;
def: string;
begin
try
defIdentity := Node.Identity.AsDefinition;
elemType := TTypes.FromScalarKind(TScalar.StringToKind(defIdentity.Definition));
except
on E: Exception do
begin
if Assigned(FLog) then
FLog.AddError(Format('Invalid type definition "%s" in new-series: %s', [Node.Definition, E.Message]), Node);
elemType := TTypes.Unknown;
end;
end;
def := Node.Definition;
// Simple heuristic for type
if def.StartsWith('[') then
elemType := TTypes.CreateRecord(nil) // Placeholder, normally parses JSON
else
elemType := TTypes.FromScalarKind(TScalar.StringToKind(def));
Result := TAst.CreateSeries(defIdentity, TTypes.CreateSeries(elemType));
Result := TAst.CreateSeries(Node.Identity.AsDefinition, TTypes.CreateSeries(elemType));
end;
function TTypeChecker.VisitAddSeriesItem(const Node: IAddSeriesItemNode): IAstNode;
var
seriesType, valueType: IStaticType;
newSeries, newValue, newLookback: IAstNode;
function TTypeChecker.VisitSeriesLength(const Node: ISeriesLengthNode): IAstNode;
begin
newSeries := Accept(Node.Series);
newValue := Accept(Node.Value);
newLookback := Accept(Node.Lookback);
seriesType := newSeries.AsTypedNode.StaticType;
valueType := newValue.AsTypedNode.StaticType;
if (seriesType.Kind <> stUnknown) then
begin
if (seriesType.Kind <> TStaticTypeKind.stSeries) then
begin
if Assigned(FLog) then
FLog.AddError(Format('"add" requires a series as its first argument, but got %s', [seriesType.ToString]), Node);
end
else
begin
if (valueType.Kind <> stUnknown) and not TTypeRules.CanAssign(seriesType.ElementType, valueType) then
begin
if Assigned(FLog) then
FLog.AddError(
Format('Cannot add item of type %s to series of type %s', [valueType.ToString, seriesType.ElementType.ToString]),
Node
);
end;
end;
end;
if (newLookback <> nil) then
begin
var lookbackType := newLookback.AsTypedNode.StaticType;
if (lookbackType.Kind <> stUnknown) and not (lookbackType.Kind = TStaticTypeKind.stOrdinal) then
begin
if Assigned(FLog) then
FLog.AddError('Lookback parameter for "add" must be an ordinal value.', Node);
end;
end;
Result := TAst.AddSeriesItem(Node.Identity, newSeries.AsIdentifier, newValue, newLookback, TTypes.Void);
Result := TAst.SeriesLength(Node.Identity, Accept(Node.Series).AsIdentifier, TTypes.Ordinal);
end;
function TTypeChecker.VisitNop(const Node: INopNode): IAstNode;
@@ -968,23 +707,174 @@ begin
Result := TAst.Nop(Node.Identity, TTypes.Void);
end;
function TTypeChecker.VisitSeriesLength(const Node: ISeriesLengthNode): IAstNode;
var
seriesType: IStaticType;
newSeries: IAstNode;
begin
newSeries := Accept(Node.Series);
seriesType := newSeries.AsTypedNode.StaticType;
// =============================================================================
// PIPE IMPLEMENTATION (Type Checking)
// =============================================================================
if (seriesType.Kind <> stUnknown)
and (seriesType.Kind <> TStaticTypeKind.stSeries)
and (seriesType.Kind <> TStaticTypeKind.stRecordSeries) then
function TTypeChecker.VisitPipeInput(const Node: IPipeInputNode): IAstNode;
var
newSource: IIdentifierNode;
sourceType: IStaticType;
newSelectors: TArray<IKeywordNode>;
i: Integer;
begin
newSource := Accept(Node.StreamSource).AsIdentifier;
sourceType := newSource.AsTypedNode.StaticType;
// 1. Verify Source is a Series-compatible type
if (sourceType.Kind <> stUnknown) then
begin
if not ((sourceType.Kind = stSeries) or (sourceType.Kind = stRecordSeries)) then
begin
if Assigned(FLog) then
FLog.AddError(Format('"length" requires a series, but got %s', [seriesType.ToString]), Node);
FLog.AddError(
Format('Pipe input "%s" must be a Series or RecordSeries, but got %s.', [newSource.Name, sourceType.ToString]),
Node
);
end
else if (sourceType.Kind = stRecordSeries) then
begin
// 2. Verify Selectors exist in Record Definition
var def := sourceType.Definition;
for var sel in Node.Selectors do
begin
if def.IndexOf(sel.Value) < 0 then
begin
if Assigned(FLog) then
FLog.AddError(Format('Field ":%s" not found in stream "%s".', [sel.Value.Name, newSource.Name]), sel);
end;
end;
end;
end;
Result := TAst.SeriesLength(Node.Identity, newSeries.AsIdentifier, TTypes.Ordinal);
// Reconstruct list simply to pass through
SetLength(newSelectors, Node.Selectors.Count);
for i := 0 to Node.Selectors.Count - 1 do
newSelectors[i] := Node.Selectors[i];
Result := TAst.PipeInput(newSource, TAst.PipeSelectorList(newSelectors, Node.Selectors.Identity.Location), Node.Identity.Location);
end;
function TTypeChecker.VisitPipe(const Node: IPipeNode): IAstNode;
var
i, k: Integer;
inputNode: IPipeInputNode;
newInputs: TArray<IPipeInputNode>;
streamType: IStaticType;
paramTypes: TList<IStaticType>;
lambda: ILambdaExpressionNode;
newParams: TArray<IIdentifierNode>;
inferredType: IStaticType;
begin
SetLength(newInputs, Node.Inputs.Count);
paramTypes := TList<IStaticType>.Create;
try
// 1. Visit Inputs and collect types for Lambda parameters
for i := 0 to Node.Inputs.Count - 1 do
begin
inputNode := Accept(Node.Inputs[i]).AsPipeInput;
newInputs[i] := inputNode;
streamType := inputNode.StreamSource.AsTypedNode.StaticType;
// Flatten logic: One lambda param per selector
for var sel in inputNode.Selectors do
begin
inferredType := TTypes.Unknown;
if streamType.Kind = stRecordSeries then
begin
// Extract field type from definition
var def := streamType.Definition;
var idx := def.IndexOf(sel.Value);
if idx >= 0 then
inferredType := TTypes.FromScalarKind(def.Items[idx].Value);
end
else if streamType.Kind = stSeries then
begin
// If simple series, use its element type
if Assigned(streamType.ElementType) then
inferredType := streamType.ElementType
else
inferredType := TTypes.Ordinal; // Fallback default
end;
paramTypes.Add(inferredType);
end;
end;
// 2. Prepare Lambda with Inferred Types
lambda := Node.Transformation;
if lambda.Parameters.Count <> paramTypes.Count then
begin
if Assigned(FLog) then
FLog.AddError(
Format(
'Pipe lambda expects %d parameters (one per selector), but got %d.',
[paramTypes.Count, lambda.Parameters.Count]
),
lambda
);
end;
SetLength(newParams, lambda.Parameters.Count);
for k := 0 to lambda.Parameters.Count - 1 do
begin
var oldP := lambda.Parameters[k];
var typeToInject :=
if k < paramTypes.Count then paramTypes[k]
else TTypes.Unknown;
// Create new identifier with the inferred type!
newParams[k] := TAst.Identifier(oldP.Identity.AsNamed, oldP.Address, typeToInject);
end;
// Recreate Lambda NODE with Typed Parameters
var preTypedLambda :=
TAst.LambdaExpr(
lambda.Identity,
TParameterList.Create(newParams, lambda.Parameters.Identity),
lambda.Body,
lambda.Layout,
lambda.Descriptor,
lambda.Upvalues,
lambda.HasNestedLambdas,
lambda.IsPure,
TTypes.Unknown // Will be recalculated in Accept
);
// 3. Visit the Lambda (This will now type-check the Body using the types we just injected)
var typedLambda := Accept(preTypedLambda).AsLambdaExpression;
// 4. Infer Pipe Return Type & Validate Strictness
var lambdaRetType := typedLambda.AsTypedNode.StaticType.Signatures[0].ReturnType;
var pipeType: IStaticType;
if lambdaRetType.Kind = stRecord then
begin
// Valid: Record -> RecordSeries
pipeType := TTypes.CreateRecordSeries(lambdaRetType.Definition);
end
else
begin
// STRICT CHECK: Scalars are NOT allowed.
if (lambdaRetType.Kind <> stUnknown) and (lambdaRetType.Kind <> stVoid) then
begin
if Assigned(FLog) then
FLog.AddError(
Format('Pipe function must return a Record (e.g. {:res ...}). Type "%s" is invalid.', [lambdaRetType.ToString]),
lambda
);
end;
// If Void or Unknown, or Error case:
pipeType := TTypes.Unknown;
end;
Result := TAst.Pipe(Node.Identity, TPipeInputList.Create(newInputs, Node.Inputs.Identity), typedLambda, pipeType);
finally
paramTypes.Free;
end;
end;
end.
Src/AST/Myc.Ast.Debugger.pas
+56
View File
@@ -48,6 +48,12 @@ type
function VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue; override;
function VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue; override;
function VisitNop(const Node: INopNode): TDataValue; override;
// Pipe Support
function VisitPipeInput(const Node: IPipeInputNode): TDataValue; override;
function VisitPipeSelectorList(const Node: IPipeSelectorList): TDataValue; override;
function VisitPipeInputList(const Node: IPipeInputList): TDataValue; override;
function VisitPipe(const Node: IPipeNode): TDataValue; override;
end;
implementation
@@ -309,4 +315,54 @@ begin
Result := TDataValue.Void;
end;
// --- Pipe Support ---
function TDebugEvaluatorVisitor.VisitPipe(const Node: IPipeNode): TDataValue;
begin
AppendLine('Pipe {');
Indent;
try
Result := inherited VisitPipe(Node);
finally
Unindent;
end;
AppendLine(Format('} -> %s', [Result.ToString]));
end;
function TDebugEvaluatorVisitor.VisitPipeInput(const Node: IPipeInputNode): TDataValue;
begin
AppendLine(Format('PipeInput (Source: %s) {', [Node.StreamSource.Name]));
Indent;
try
Result := inherited VisitPipeInput(Node);
finally
Unindent;
end;
AppendLine('}');
end;
function TDebugEvaluatorVisitor.VisitPipeSelectorList(const Node: IPipeSelectorList): TDataValue;
begin
AppendLine('Selectors [');
Indent;
try
Result := inherited VisitPipeSelectorList(Node);
finally
Unindent;
end;
AppendLine(']');
end;
function TDebugEvaluatorVisitor.VisitPipeInputList(const Node: IPipeInputList): TDataValue;
begin
AppendLine('Inputs [');
Indent;
try
Result := inherited VisitPipeInputList(Node);
finally
Unindent;
end;
AppendLine(']');
end;
end.
Src/AST/Myc.Ast.Environment.pas
-1
View File
@@ -40,7 +40,6 @@ type
function ExpandMacros(const Node: IAstNode): IAstNode;
// Updated Bind signature to accept Log
function Bind(
const Node: IAstNode;
out Layout: IScopeLayout;
Src/AST/Myc.Ast.Evaluator.pas
+112 -14
View File
@@ -83,6 +83,8 @@ uses
Myc.Ast,
Myc.Data.Decimal,
Myc.Data.Series,
Myc.Data.Stream,
Myc.Data.Stream.Pipes,
Myc.Data.Scalar.JSON,
Myc.Ast.Types;
@@ -633,20 +635,6 @@ begin
Result := TDataValue.Void;
end;
// --- Pipe Visitors Stubs ---
function TEvaluatorVisitor.VisitPipe(const Node: IPipeNode): TDataValue;
begin
// Placeholder for Phase 4 (Runtime Integration)
// Here we will:
// 1. Resolve Input Streams from Scope
// 2. Build TPipeConfig
// 3. Compile Lambda to TDataValue.TFunc
// 4. Create Adapter
// 5. Create TPipeStream
raise EEvaluatorException.Create('Pipe execution is not yet implemented.');
end;
function TEvaluatorVisitor.VisitPipeInput(const Node: IPipeInputNode): TDataValue;
begin
Result := TDataValue.Void;
@@ -662,4 +650,114 @@ begin
Result := TDataValue.Void;
end;
// --- Pipe Implementation ---
function TEvaluatorVisitor.VisitPipe(const Node: IPipeNode): TDataValue;
var
i: Integer;
inputNode: IPipeInputNode;
sources: TArray<IStream>;
config: TPipeConfig;
inputVal: TDataValue;
sourceSeries: IScalarRecordSeries;
outputDef: IScalarRecordDefinition;
lambdaFunc: TDataValue.TFunc;
pipeAdapter: TPipeStream.TPipeLambda;
begin
SetLength(sources, Node.Inputs.Count);
SetLength(config, Node.Inputs.Count);
// 1. Resolve Inputs & Build Config
for i := 0 to Node.Inputs.Count - 1 do
begin
inputNode := Node.Inputs[i];
inputVal := FScope[inputNode.StreamSource.Address];
// STRICT CHECK: Only vkStream is allowed.
if inputVal.Kind = vkStream then
begin
sources[i] := inputVal.AsStream;
end
else
begin
raise EEvaluatorException
.CreateFmt('Variable "%s" must be a Stream. Found type "%s".', [inputNode.StreamSource.Name, inputVal.Kind.ToString]);
end;
sourceSeries := sources[i].Series;
var srcDef := sourceSeries.Def;
var selectors := inputNode.Selectors;
SetLength(config[i], selectors.Count);
for var k := 0 to selectors.Count - 1 do
begin
var key := selectors[k].Value;
var idx := srcDef.IndexOf(key);
// Runtime safety check (TypeChecker usually handles this)
if idx < 0 then
raise EEvaluatorException.CreateFmt('Field ":%s" missing in stream "%s".', [key.Name, inputNode.StreamSource.Name]);
var fieldKind := srcDef.Items[idx].Value;
config[i][k] := TScalarRecordField.Create(key, fieldKind);
end;
end;
// 2. Get Output Definition
if (Node.StaticType = nil) or (Node.StaticType.Kind <> stRecordSeries) then
raise EEvaluatorException.Create(
'Internal Error: Pipe requires a RecordSeries static type definition. Lambda must return a Record.');
outputDef := Node.StaticType.Definition;
// 3. Compile Lambda
lambdaFunc := Node.Transformation.Accept(Self).AsMethod();
// 4. Create Adapter
pipeAdapter :=
function(const SourceSeries: array of ISeries; out Results: array of TScalar.TValue): Boolean
var
scriptArgs: TArray<TDataValue>;
scriptResult: TDataValue;
k: Integer;
resRec: IScalarRecord;
begin
SetLength(scriptArgs, Length(SourceSeries));
// Pass Scalars (Current Items)
for k := 0 to High(SourceSeries) do
scriptArgs[k] := TDataValue(SourceSeries[k].Items[0]);
scriptResult := lambdaFunc(scriptArgs);
// Void -> Filtered out (no emit)
if scriptResult.IsVoid then
exit(False);
// STRICT CHECK: Only ScalarRecord allowed
if scriptResult.Kind = vkScalarRecord then
begin
resRec := scriptResult.AsScalarRecord;
// Integrity check: Runtime Record must match Static Definition
if resRec.Def.Count <> Length(Results) then
raise EEvaluatorException.Create('Pipe lambda returned record with incorrect field count/layout.');
for k := 0 to resRec.Def.Count - 1 do
Results[k] := resRec.Items[k].Value.Value;
end
else
begin
// Scalars are forbidden
raise EEvaluatorException
.CreateFmt('Pipe lambda returned invalid type "%s". Must return a Record or Void.', [scriptResult.Kind.ToString]);
end;
Result := True;
end;
var pipe := TPipeStream.Create(config, outputDef, sources, pipeAdapter);
// Result is a Stream
Result := TDataValue.FromStream(pipe);
end;
end.
Src/AST/Myc.Ast.RTL.Core.pas
+94 -94
View File
@@ -3,7 +3,7 @@ unit Myc.Ast.RTL.Core;
interface
uses
system.sysutils,
System.SysUtils,
Myc.Utils,
Myc.Data.Scalar,
Myc.Data.Value,
@@ -16,233 +16,233 @@ type
// (* --- Dynamic Fallbacks (Interpreter) --- *)
// Arithmetic
[TRtlExport('+')]
[TRtlExport('+', Pure)]
class function Add(const Args: TArray<TDataValue>): TDataValue; overload; static;
[TRtlExport('-')]
[TRtlExport('-', Pure)]
class function Subtract(const Args: TArray<TDataValue>): TDataValue; static;
[TRtlExport('*')]
[TRtlExport('*', Pure)]
class function Multiply(const Args: TArray<TDataValue>): TDataValue; static;
[TRtlExport('/')]
[TRtlExport('/', Pure)]
class function Divide(const Args: TArray<TDataValue>): TDataValue; static;
[TRtlExport('div')]
[TRtlExport('div', Pure)]
class function IntDivide(const Args: TArray<TDataValue>): TDataValue; static;
[TRtlExport('mod')]
[TRtlExport('mod', Pure)]
class function Modulus(const Args: TArray<TDataValue>): TDataValue; static;
// Comparison
[TRtlExport('=')]
[TRtlExport('=', Impure)]
class function Equal(const Args: TArray<TDataValue>): TDataValue; static;
[TRtlExport('<>')]
[TRtlExport('<>', Impure)]
class function NotEqual(const Args: TArray<TDataValue>): TDataValue; static;
[TRtlExport('<')]
[TRtlExport('<', Impure)]
class function LessThan(const Args: TArray<TDataValue>): TDataValue; static;
[TRtlExport('<=')]
[TRtlExport('<=', Impure)]
class function LessThanOrEqual(const Args: TArray<TDataValue>): TDataValue; static;
[TRtlExport('>')]
[TRtlExport('>', Impure)]
class function GreaterThan(const Args: TArray<TDataValue>): TDataValue; static;
[TRtlExport('>=')]
[TRtlExport('>=', Impure)]
class function GreaterThanOrEqual(const Args: TArray<TDataValue>): TDataValue; static;
// Logic / Bitwise
[TRtlExport('not')]
[TRtlExport('not', Impure)]
class function LogicalNot(const Args: TArray<TDataValue>): TDataValue; static;
[TRtlExport('and')]
[TRtlExport('and', Impure)]
class function BitwiseAnd(const Args: TArray<TDataValue>): TDataValue; static;
[TRtlExport('or')]
[TRtlExport('or', Impure)]
class function BitwiseOr(const Args: TArray<TDataValue>): TDataValue; static;
[TRtlExport('xor')]
[TRtlExport('xor', Impure)]
class function BitwiseXor(const Args: TArray<TDataValue>): TDataValue; static;
[TRtlExport('shl')]
[TRtlExport('shl', Impure)]
class function LeftShift(const Args: TArray<TDataValue>): TDataValue; static;
[TRtlExport('shr')]
[TRtlExport('shr', Impure)]
class function RightShift(const Args: TArray<TDataValue>): TDataValue; static;
// (* Dynamic fallbacks for TScalar input *)
[TRtlExport('Abs')]
[TRtlExport('Abs', Impure)]
class function Abs(const Arg: TScalar): TScalar; static;
[TRtlExport('Round')]
[TRtlExport('Round', Impure)]
class function Round(const Arg: TScalar): TScalar; static;
[TRtlExport('Trunc')]
[TRtlExport('Trunc', Impure)]
class function Trunc(const Arg: TScalar): TScalar; static;
[TRtlExport('Ceil')]
[TRtlExport('Ceil', Impure)]
class function Ceil(const Arg: TScalar): TScalar; static;
[TRtlExport('Floor')]
[TRtlExport('Floor', Impure)]
class function Floor(const Arg: TScalar): TScalar; static;
[TRtlExport('Sign')]
[TRtlExport('Sign', Impure)]
class function Sign(const Arg: TScalar): TScalar; static;
// (* DateTime Constructors *)
[TRtlExport('Now', False)]
[TRtlExport('Now', Impure)]
class function Now(const Args: TArray<TDataValue>): TDataValue; static;
[TRtlExport('Date')]
[TRtlExport('Date', Impure)]
class function Date(const Args: TArray<TDataValue>): TDataValue; static;
// (* Other dynamic functions *)
[TRtlExport('Memoize')]
[TRtlExport('Memoize', Impure)]
class function Memoize(const Args: TArray<TDataValue>): TDataValue; static;
[TRtlExport('Map')]
[TRtlExport('Map', Impure)]
class function Map(const Args: TArray<TDataValue>): TDataValue; static;
[TRtlExport('Reduce')]
[TRtlExport('Reduce', Impure)]
class function Reduce(const Args: TArray<TDataValue>): TDataValue; static;
[TRtlExport('Where')]
[TRtlExport('Where', Impure)]
class function Where(const Args: TArray<TDataValue>): TDataValue; static;
[TRtlExport('Any')]
[TRtlExport('Any', Impure)]
class function Any(const Args: TArray<TDataValue>): TDataValue; static;
// (* --- Static Specializations (Monomorphization Targets) --- *)
// Add
[TRtlExport('+', True)]
[TRtlExport('+', Pure)]
class function Add_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64; static;
[TRtlExport('+', True)]
[TRtlExport('+', Pure)]
class function Add_Float_Float_Float(A, B: Double): Double; static;
[TRtlExport('+', True)]
[TRtlExport('+', Pure)]
class function Add_Ordinal_Float_Float(A: Int64; B: Double): Double; static;
[TRtlExport('+', True)]
[TRtlExport('+', Pure)]
class function Add_Float_Ordinal_Float(A: Double; B: Int64): Double; static;
[TRtlExport('+', True)]
[TRtlExport('+', Pure)]
class function Add_Text_Text_Text(const A: String; const B: String): String; static;
// Subtract
[TRtlExport('-', True)]
[TRtlExport('-', Pure)]
class function Subtract_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64; static;
[TRtlExport('-', True)]
[TRtlExport('-', Pure)]
class function Subtract_Float_Float_Float(A, B: Double): Double; static;
[TRtlExport('-', True)]
[TRtlExport('-', Pure)]
class function Subtract_Ordinal_Float_Float(A: Int64; B: Double): Double; static;
[TRtlExport('-', True)]
[TRtlExport('-', Pure)]
class function Subtract_Float_Ordinal_Float(A: Double; B: Int64): Double; static;
// Multiply
[TRtlExport('*', True)]
[TRtlExport('*', Pure)]
class function Multiply_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64; static;
[TRtlExport('*', True)]
[TRtlExport('*', Pure)]
class function Multiply_Float_Float_Float(A, B: Double): Double; static;
[TRtlExport('*', True)]
[TRtlExport('*', Pure)]
class function Multiply_Ordinal_Float_Float(A: Int64; B: Double): Double; static;
[TRtlExport('*', True)]
[TRtlExport('*', Pure)]
class function Multiply_Float_Ordinal_Float(A: Double; B: Int64): Double; static;
// Divide (Impure due to EDivByZero potential)
[TRtlExport('/')]
[TRtlExport('/', Impure)]
class function Divide_Ordinal_Ordinal_Float(A, B: Int64): Double; static;
[TRtlExport('/')]
[TRtlExport('/', Impure)]
class function Divide_Float_Float_Float(A, B: Double): Double; static;
[TRtlExport('/')]
[TRtlExport('/', Impure)]
class function Divide_Ordinal_Float_Float(A: Int64; B: Double): Double; static;
[TRtlExport('/')]
[TRtlExport('/', Impure)]
class function Divide_Float_Ordinal_Float(A: Double; B: Int64): Double; static;
// Integer Math (Impure due to EDivByZero)
[TRtlExport('div')]
[TRtlExport('div', Impure)]
class function Div_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64; static;
[TRtlExport('mod')]
[TRtlExport('mod', Impure)]
class function Mod_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64; static;
// Comparisons
[TRtlExport('=', True)]
[TRtlExport('=', Pure)]
class function Equal_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64; static;
[TRtlExport('=', True)]
[TRtlExport('=', Pure)]
class function Equal_Float_Float_Ordinal(A, B: Double): Int64; static;
[TRtlExport('=', True)]
[TRtlExport('=', Pure)]
class function Equal_Ordinal_Float_Ordinal(A: Int64; B: Double): Int64; static;
[TRtlExport('=', True)]
[TRtlExport('=', Pure)]
class function Equal_Float_Ordinal_Ordinal(A: Double; B: Int64): Int64; static;
[TRtlExport('=', True)]
[TRtlExport('=', Pure)]
class function Equal_Keyword_Keyword_Ordinal(A, B: Int64): Int64; static;
[TRtlExport('<>', True)]
[TRtlExport('<>', Pure)]
class function NotEqual_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64; static;
[TRtlExport('<>', True)]
[TRtlExport('<>', Pure)]
class function NotEqual_Float_Float_Ordinal(A, B: Double): Int64; static;
[TRtlExport('<>', True)]
[TRtlExport('<>', Pure)]
class function NotEqual_Ordinal_Float_Ordinal(A: Int64; B: Double): Int64; static;
[TRtlExport('<>', True)]
[TRtlExport('<>', Pure)]
class function NotEqual_Float_Ordinal_Ordinal(A: Double; B: Int64): Int64; static;
[TRtlExport('<>', True)]
[TRtlExport('<>', Pure)]
class function NotEqual_Keyword_Keyword_Ordinal(A, B: Int64): Int64; static;
[TRtlExport('<', True)]
[TRtlExport('<', Pure)]
class function Less_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64; static;
[TRtlExport('<', True)]
[TRtlExport('<', Pure)]
class function Less_Float_Float_Ordinal(A, B: Double): Int64; static;
[TRtlExport('<', True)]
[TRtlExport('<', Pure)]
class function Less_Ordinal_Float_Ordinal(A: Int64; B: Double): Int64; static;
[TRtlExport('<', True)]
[TRtlExport('<', Pure)]
class function Less_Float_Ordinal_Ordinal(A: Double; B: Int64): Int64; static;
[TRtlExport('<=', True)]
[TRtlExport('<=', Pure)]
class function LessOrEqual_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64; static;
[TRtlExport('<=', True)]
[TRtlExport('<=', Pure)]
class function LessOrEqual_Float_Float_Ordinal(A, B: Double): Int64; static;
[TRtlExport('<=', True)]
[TRtlExport('<=', Pure)]
class function LessOrEqual_Ordinal_Float_Ordinal(A: Int64; B: Double): Int64; static;
[TRtlExport('<=', True)]
[TRtlExport('<=', Pure)]
class function LessOrEqual_Float_Ordinal_Ordinal(A: Double; B: Int64): Int64; static;
[TRtlExport('>', True)]
[TRtlExport('>', Pure)]
class function Greater_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64; static;
[TRtlExport('>', True)]
[TRtlExport('>', Pure)]
class function Greater_Float_Float_Ordinal(A, B: Double): Int64; static;
[TRtlExport('>', True)]
[TRtlExport('>', Pure)]
class function Greater_Ordinal_Float_Ordinal(A: Int64; B: Double): Int64; static;
[TRtlExport('>', True)]
[TRtlExport('>', Pure)]
class function Greater_Float_Ordinal_Ordinal(A: Double; B: Int64): Int64; static;
[TRtlExport('>=', True)]
[TRtlExport('>=', Pure)]
class function GreaterOrEqual_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64; static;
[TRtlExport('>=', True)]
[TRtlExport('>=', Pure)]
class function GreaterOrEqual_Float_Float_Ordinal(A, B: Double): Int64; static;
[TRtlExport('>=', True)]
[TRtlExport('>=', Pure)]
class function GreaterOrEqual_Ordinal_Float_Ordinal(A: Int64; B: Double): Int64; static;
[TRtlExport('>=', True)]
[TRtlExport('>=', Pure)]
class function GreaterOrEqual_Float_Ordinal_Ordinal(A: Double; B: Int64): Int64; static;
// Bitwise Static
[TRtlExport('and', True)]
[TRtlExport('and', Pure)]
class function And_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64; static;
[TRtlExport('or', True)]
[TRtlExport('or', Pure)]
class function Or_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64; static;
[TRtlExport('xor', True)]
[TRtlExport('xor', Pure)]
class function Xor_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64; static;
[TRtlExport('shl', True)]
[TRtlExport('shl', Pure)]
class function Shl_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64; static;
[TRtlExport('shr', True)]
[TRtlExport('shr', Pure)]
class function Shr_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64; static;
// Unary
[TRtlExport('-', True)]
[TRtlExport('-', Pure)]
class function Negate_Ordinal_Ordinal(A: Int64): Int64; static;
[TRtlExport('-', True)]
[TRtlExport('-', Pure)]
class function Negate_Float_Float(A: Double): Double; static;
[TRtlExport('not', True)]
[TRtlExport('not', Pure)]
class function Not_Ordinal_Ordinal(A: Int64): Int64; static;
// Standard functions
[TRtlExport('Abs', True)]
[TRtlExport('Abs', Pure)]
class function Abs_Ordinal_Ordinal(A: Int64): Int64; static;
[TRtlExport('Abs', True)]
[TRtlExport('Abs', Pure)]
class function Abs_Float_Float(A: Double): Double; static;
[TRtlExport('Round', True)]
[TRtlExport('Round', Pure)]
class function Round_Ordinal_Ordinal(A: Int64): Int64; static;
[TRtlExport('Round', True)]
[TRtlExport('Round', Pure)]
class function Round_Float_Ordinal(A: Double): Int64; static;
[TRtlExport('Trunc', True)]
[TRtlExport('Trunc', Pure)]
class function Trunc_Ordinal_Ordinal(A: Int64): Int64; static;
[TRtlExport('Trunc', True)]
[TRtlExport('Trunc', Pure)]
class function Trunc_Float_Ordinal(A: Double): Int64; static;
end;
implementation
uses
system.generics.collections,
system.math,
system.dateutils,
System.Generics.Collections,
System.Math,
System.Dateutils,
Myc.Data.Decimal;
{ TRtlFunctions - Operator Implementations }
Src/AST/Myc.Ast.RTL.pas
+5 -3
View File
@@ -20,11 +20,13 @@ uses
type
// Defines the export parameters for a native RTL function.
TRtlExportAttribute = class(TCustomAttribute)
type
TPurity = (Pure, Impure);
public
Name: string;
IsPure: Boolean;
constructor Create(const AName: string); overload;
constructor Create(const AName: string; AIsPure: Boolean); overload;
constructor Create(const AName: string; APurity: TPurity); overload;
end;
// Defines the key for the static bootstrap cache.
@@ -160,11 +162,11 @@ begin
Self.IsPure := False; // Default to impure (safe)
end;
constructor TRtlExportAttribute.Create(const AName: string; AIsPure: Boolean);
constructor TRtlExportAttribute.Create(const AName: string; APurity: TPurity);
begin
inherited Create;
Self.Name := AName;
Self.IsPure := AIsPure;
Self.IsPure := APurity = Pure;
end;
{ TStaticSignatureKey }
Src/AST/Myc.Ast.Visitor.pas
+4
View File
@@ -545,18 +545,22 @@ function TAstTransformer.VisitConstant(const Node: IConstantNode): IAstNode;
begin
Result := Node;
end;
function TAstTransformer.VisitIdentifier(const Node: IIdentifierNode): IAstNode;
begin
Result := Node;
end;
function TAstTransformer.VisitKeyword(const Node: IKeywordNode): IAstNode;
begin
Result := Node;
end;
function TAstTransformer.VisitNop(const Node: INopNode): IAstNode;
begin
Result := Node;
end;
function TAstTransformer.VisitCreateSeries(const Node: ICreateSeriesNode): IAstNode;
begin
Result := Node;
Src/Data/Myc.Data.Scalar.pas
+14 -2
View File
@@ -26,6 +26,8 @@ type
// The 8-byte storage for the scalar value
PValue = ^TValue;
TValue = record
class operator Implicit(A: Int64): TValue; overload;
class operator Implicit(A: Double): TValue; overload;
case TKind of
TKind.Ordinal, TKind.Keyword, TKind.Boolean: (AsInt64: Int64);
TKind.Float, TKind.DateTime: (AsDouble: Double);
@@ -190,19 +192,19 @@ type
IScalarRecordSeries = interface(IKeywordMapping<ISeries>)
{$region 'private'}
function GetDef: IScalarRecordDefinition;
function GetTotalCount: Int64;
{$endregion}
property Def: IScalarRecordDefinition read GetDef;
property TotalCount: Int64 read GetTotalCount;
end;
IWriteableScalarRecordSeries = interface(IScalarRecordSeries)
{$region 'private'}
function GetRecordCount: Int64;
function GetTotalCount: Int64;
{$endregion}
procedure Add(const Item: IKeywordMapping<TScalar>; Lookback: Int64 = -1); overload;
procedure Add(const Items: array of TScalar.TValue; Lookback: Int64 = -1); overload;
property RecordCount: Int64 read GetRecordCount;
property TotalCount: Int64 read GetTotalCount;
end;
// A series of scalar records, optimized for memory and access speed.
@@ -1071,6 +1073,16 @@ begin
Result := FDef.IndexOf(Key);
end;
class operator TScalar.TValue.Implicit(A: Int64): TValue;
begin
Result.AsInt64 := A;
end;
class operator TScalar.TValue.Implicit(A: Double): TValue;
begin
Result.AsDouble := A;
end;
initialization
Assert(sizeof(TScalar.TValue) = 8);
Src/Data/Myc.Data.Stream.pas
-1
View File
@@ -9,7 +9,6 @@ uses
System.SyncObjs,
Myc.Data.Scalar,
Myc.Data.Keyword,
Myc.Data.Value,
Myc.Core.Notifier;
type
Src/Data/Myc.Data.Value.pas
+23
View File
@@ -9,6 +9,7 @@ uses
Myc.Utils,
Myc.Data.Scalar,
Myc.Data.Series,
Myc.Data.Stream,
Myc.Data.Keyword;
type
@@ -24,6 +25,7 @@ type
vkMethod,
vkInterface,
vkPointer,
vkStream,
vkGeneric
);
@@ -86,6 +88,9 @@ type
class function FromGenericRecord(const AValue: IKeywordMapping<TDataValue>): TDataValue; static; inline;
class function FromSeries(const AValue: ISeries): TDataValue; static; inline;
// New Factory for Streams
class function FromStream(const AStream: IStream): TDataValue; static; inline;
// --- Existing Accessors ---
function AsScalar: TScalar; inline;
function AsMethod: TFunc; inline;
@@ -96,6 +101,9 @@ type
function AsSeries: ISeries; inline;
function AsObject: TObject; overload; inline;
// New Accessor for Streams
function AsStream: IStream; inline;
function ToString: String;
property IsVoid: Boolean read GetIsVoid;
property Kind: TDataValueKind read FKind;
@@ -141,6 +149,7 @@ begin
vkInterface: Result := 'Interface';
vkPointer: Result := 'Pointer';
vkGeneric: Result := 'Generic';
vkStream: Result := 'Stream';
else
Result := 'Unknown';
end;
@@ -273,6 +282,12 @@ begin
Result.FInterface := AValue;
end;
class function TDataValue.FromStream(const AStream: IStream): TDataValue;
begin
Result.FKind := vkStream;
Result.FInterface := AStream;
end;
class function TDataValue.Map(const SourceSeries: ISeries; const MapperFunc: TFunc): ISeries;
begin
Result := TMapSeries.Create(SourceSeries, MapperFunc);
@@ -285,6 +300,13 @@ begin
Result := ISeries(FInterface);
end;
function TDataValue.AsStream: IStream;
begin
if (FKind <> vkStream) then
raise EInvalidCast.Create('Cannot read value as Stream.');
Result := IStream(FInterface);
end;
function TDataValue.AsMethod: TFunc;
begin
if (FKind <> vkMethod) then
@@ -443,6 +465,7 @@ begin
sb.Free;
end;
end;
vkStream: Result := '<stream>';
vkVoid: Result := '<void>';
vkMethod: Result := '<method>';
vkGeneric: Result := '<generic>';
Test/AST/Test.Myc.Ast.Compiler.Macros.pas
+2
View File
@@ -37,6 +37,7 @@ type
// --- Basic Functionality ---
[Test]
[IgnoreMemoryLeaks]
[TestCase('Identity', '(defmacro id [x] `~x), (id 42), 42')]
[TestCase('Constant', '(defmacro c [] `100), (c), 100')]
[TestCase('SimpleAdd', '(defmacro add [a b] `(+ ~a ~b)), (add 10 20), 30')]
@@ -45,6 +46,7 @@ type
// --- Quasiquoting & Unquoting ---
[Test]
[IgnoreMemoryLeaks]
procedure Test_Quasiquote_Literal;
[Test]
Test/AST/Test.Myc.Ast.NullPropagation.pas
+3
View File
@@ -26,12 +26,15 @@ type
[Test]
[TestCase('ValidRecord', 'true,10')]
[TestCase('VoidRecord', 'false,0')]
[IgnoreMemoryLeaks]
procedure TestMemberAccessPropagation(const Condition: Boolean; const ExpectedVal: Int64);
[Test]
[IgnoreMemoryLeaks]
procedure TestNestedPropagation;
[Test]
[IgnoreMemoryLeaks]
procedure TestIndexerPropagation;
[Test]
Test/AST/Test.Myc.Ast.Pipes.pas
+287
View File
@@ -0,0 +1,287 @@
unit Test.Myc.Ast.Pipes;
interface
uses
System.SysUtils,
System.Classes,
System.Generics.Collections,
System.SyncObjs,
DUnitX.TestFramework,
// Core Data & Types
Myc.Data.Value,
Myc.Data.Scalar,
Myc.Data.Keyword,
Myc.Data.Stream,
Myc.Data.Series,
// AST & Compiler
Myc.Ast,
Myc.Ast.Nodes,
Myc.Ast.Types,
Myc.Ast.Environment,
Myc.Ast.Script;
type
// Mock Stream that allows manual signaling
TTestStream = class(TInterfacedObject, IStream)
private
FSeries: IScalarRecordSeries;
FObservers: TList<IStreamObserver>;
FLock: TSpinLock;
public
constructor Create(const ASeries: IScalarRecordSeries);
destructor Destroy; override;
// Manual trigger
procedure Emit(CycleID: Integer);
// IStream implementation
function Subscribe(const Observer: IStreamObserver): TSubscriptionTag;
procedure Unsubscribe(Tag: TSubscriptionTag);
function GetSeries: IScalarRecordSeries;
property Series: IScalarRecordSeries read GetSeries;
end;
[TestFixture]
[IgnoreMemoryLeaks]
TTestPipes = class
private
FEnv: TAstEnvironment;
function CreateSourceSeries(
const FieldName: string;
Kind: TScalar.TKind;
const Values: TArray<Int64>
): IWriteableScalarRecordSeries;
public
[Setup]
procedure Setup;
[Test]
procedure Test_SimplePipe_Arithmetic;
[Test]
procedure Test_TypeChecker_Fail_On_Invalid_Field;
[Test]
procedure Test_MultiSource_Pipe;
end;
implementation
//------------------------------------------------------------------------------
// TTestStream Implementation
//------------------------------------------------------------------------------
constructor TTestStream.Create(const ASeries: IScalarRecordSeries);
begin
inherited Create;
FSeries := ASeries;
FObservers := TList<IStreamObserver>.Create;
FLock := Default(TSpinLock);
end;
destructor TTestStream.Destroy;
begin
FObservers.Free;
inherited;
end;
function TTestStream.GetSeries: IScalarRecordSeries;
begin
Result := FSeries;
end;
function TTestStream.Subscribe(const Observer: IStreamObserver): TSubscriptionTag;
begin
FLock.Enter;
try
FObservers.Add(Observer);
// Use the interface pointer as tag.
Result := TSubscriptionTag(Observer);
finally
FLock.Exit;
end;
end;
procedure TTestStream.Unsubscribe(Tag: TSubscriptionTag);
var
obs: IStreamObserver;
begin
// We treat the tag as the interface pointer.
// Note: This relies on the caller ensuring the object is still alive
// if they want to unsubscribe, which is standard behavior.
obs := IStreamObserver(Tag);
FLock.Enter;
try
FObservers.Remove(obs);
finally
FLock.Exit;
end;
end;
procedure TTestStream.Emit(CycleID: Integer);
var
obs: IStreamObserver;
observersCopy: TArray<IStreamObserver>;
begin
FLock.Enter;
try
observersCopy := FObservers.ToArray;
finally
FLock.Exit;
end;
// Simulate new data arrival
for obs in observersCopy do
begin
obs.OnSignal(TStreamSignal.Create(skData, CycleID));
end;
end;
//------------------------------------------------------------------------------
// TTestPipes Implementation
//------------------------------------------------------------------------------
procedure TTestPipes.Setup;
begin
FEnv := TAstEnvironment.Construct(nil);
end;
function TTestPipes.CreateSourceSeries(
const FieldName: string;
Kind: TScalar.TKind;
const Values: TArray<Int64>
): IWriteableScalarRecordSeries;
var
fields: TArray<TScalarRecordField>;
def: IScalarRecordDefinition;
i: Integer;
val: TScalar.TValue;
recValues: TArray<TScalar.TValue>;
begin
SetLength(fields, 1);
fields[0] := TScalarRecordField.Create(TKeywordRegistry.Intern(FieldName), Kind);
def := TKeywordMappingRegistry<TScalar.TKind>.Intern(fields);
Result := TScalarRecordSeries.Create(def);
SetLength(recValues, 1);
for i := 0 to High(Values) do
begin
val.AsInt64 := Values[i];
recValues[0] := val;
Result.Add(recValues);
end;
end;
procedure TTestPipes.Test_SimplePipe_Arithmetic;
var
source: IWriteableScalarRecordSeries;
mockStream: TTestStream; // Keep reference to fire later
script: string;
resVal: TDataValue;
resStream: IStream;
resSeries: IScalarRecordSeries;
item: TScalar;
key: IKeyword;
begin
// Arrange
source := CreateSourceSeries('val', TScalar.TKind.Ordinal, [10, 20, 30]);
mockStream := TTestStream.Create(source);
FEnv.RootScope.Define('src', TDataValue.FromStream(mockStream), TTypes.CreateRecordSeries(source.Def));
// Act
script := '(pipe [src [:val]] (fn [x] {:res (* x 2)}))';
// 1. Compile & Link & Run (Constructs the Pipe Object)
resVal := FEnv.Run(TAstScript.Parse(script));
Assert.AreEqual(TDataValueKind.vkStream, resVal.Kind);
resStream := resVal.AsStream;
resSeries := resStream.Series;
// 2. Fire Data! (Now that pipe is fully constructed)
mockStream.Emit(0);
// Assert
Assert.AreEqual(Int64(1), resSeries.TotalCount, 'TotalCount mismatch');
key := TKeywordRegistry.Intern('res');
item := resSeries.Fields[key].Items[0];
Assert.AreEqual(Int64(60), item.Value.AsInt64, 'Item[0] incorrect');
end;
procedure TTestPipes.Test_TypeChecker_Fail_On_Invalid_Field;
var
source: IWriteableScalarRecordSeries;
mockStream: TTestStream;
script: string;
begin
source := CreateSourceSeries('val', TScalar.TKind.Ordinal, [1]);
mockStream := TTestStream.Create(source);
FEnv.RootScope.Define('src', TDataValue.FromStream(mockStream), TTypes.CreateRecordSeries(source.Def));
script := '(pipe [src [:non_existent]] (fn [x] {:res x}))';
Assert.WillRaise(procedure begin FEnv.Run(TAstScript.Parse(script)); end, ECompilationFailed);
end;
procedure TTestPipes.Test_MultiSource_Pipe;
var
s1, s2: IWriteableScalarRecordSeries;
m1, m2: TTestStream;
script: string;
key: IKeyword;
resSeries: IScalarRecordSeries;
begin
key := TKeywordRegistry.Intern('sum');
// Arrange
s1 := CreateSourceSeries('a', TScalar.TKind.Ordinal, [20]);
s2 := CreateSourceSeries('b', TScalar.TKind.Ordinal, [6]);
m1 := TTestStream.Create(s1);
m2 := TTestStream.Create(s2);
FEnv.RootScope.Define('in1', TDataValue.FromStream(m1), TTypes.CreateRecordSeries(s1.Def));
FEnv.RootScope.Define('in2', TDataValue.FromStream(m2), TTypes.CreateRecordSeries(s2.Def));
// Act
script := '(pipe [in1 [:a] in2 [:b]] (fn [valA valB] {:sum (+ valA valB)}))';
resSeries := FEnv.Run(TAstScript.Parse(script)).AsStream.Series;
Assert.AreEqual(Int64(0), resSeries.TotalCount);
// Partial update - no result expected
m1.Emit(0);
Assert.AreEqual(Int64(0), resSeries.TotalCount);
// Complete update - result expected
m2.Emit(0);
Assert.AreEqual(Int64(1), resSeries.TotalCount);
Assert.AreEqual(Int64(26), resSeries.Fields[key].Items[0].Value.AsInt64);
// Next cycle
s1.Add([10]);
m1.Emit(1);
Assert.AreEqual(Int64(1), resSeries.TotalCount);
s2.Add([5]);
m2.Emit(1);
Assert.AreEqual(Int64(2), resSeries.TotalCount);
// Check history (Lookback 0 is newest)
// Items[0] is the result of Cycle 1 (10 + 5 = 15)
Assert.AreEqual(Int64(15), resSeries.Fields[key].Items[0].Value.AsInt64);
// Items[1] is the result of Cycle 0 (20 + 6 = 26)
Assert.AreEqual(Int64(26), resSeries.Fields[key].Items[1].Value.AsInt64);
end;
end.
Test/AST/Test.Myc.Ast.Stream.Pipes.pas
+313
View File
@@ -0,0 +1,313 @@
unit Test.Myc.Ast.Stream.Pipes;
interface
uses
DUnitX.TestFramework,
System.SysUtils,
System.Generics.Collections,
// Core Units
Myc.Data.Scalar,
Myc.Data.Keyword,
Myc.Data.Value,
Myc.Data.Series,
Myc.Data.Stream,
Myc.Data.Stream.Pipes,
// AST & Compiler
Myc.Ast,
Myc.Ast.Nodes,
Myc.Ast.Scope,
Myc.Ast.Types,
Myc.Ast.Identities,
Myc.Ast.Script,
Myc.Ast.Compiler.Binder,
Myc.Ast.Compiler.TypeChecker,
Myc.Ast.Evaluator;
type
// Helper: Captures compiler errors so we can assert on them
TCapturingLog = class(TInterfacedObject, ICompilerLog)
private
FErrors: TList<string>;
public
constructor Create;
destructor Destroy; override;
procedure Add(ALevel: TCompilerErrorLevel; const AMessage: string; const ANode: IAstNode = nil);
procedure AddError(const AMessage: string; const ANode: IAstNode = nil);
procedure AddWarning(const AMessage: string; const ANode: IAstNode = nil);
function HasErrors: Boolean;
function GetEntryCount: Integer;
function GetEntries: TArray<TCompilerError>;
property Errors: TList<string> read FErrors;
end;
// Helper: Collects stream output for assertions
TDataCollector = class(TInterfacedObject, IStreamObserver)
private
FStream: IStream;
FLastRecord: IScalarRecord;
FSignalCount: Integer;
public
constructor Create(AStream: IStream);
procedure OnSignal(const Signal: TStreamSignal);
property LastRecord: IScalarRecord read FLastRecord;
property SignalCount: Integer read FSignalCount;
end;
[TestFixture]
TPipeIntegrationTests = class
private
FGraph: IGraphExecutor;
FLog: TCapturingLog;
FRootLayout: IScopeLayout;
FRootScope: IExecutionScope;
FInputChannel: IInputChannel;
// Simulates the Host Application setting up the environment ('btc' variable)
procedure SetupHostEnvironment;
// Compiles and Runs a script source
function CompileAndRun(const Source: string): IStream;
public
[Setup]
procedure Setup;
[Teardown]
procedure Teardown;
[Test]
procedure Test_Simple_Pipe_Throughput;
[Test]
procedure Test_Pipe_Field_Mapping_And_Calculation;
end;
implementation
{ TCapturingLog }
constructor TCapturingLog.Create;
begin
FErrors := TList<string>.Create;
end;
destructor TCapturingLog.Destroy;
begin
FErrors.Free;
inherited;
end;
procedure TCapturingLog.Add(ALevel: TCompilerErrorLevel; const AMessage: string; const ANode: IAstNode);
begin
if ALevel = elError then
FErrors.Add(AMessage);
end;
procedure TCapturingLog.AddError(const AMessage: string; const ANode: IAstNode);
begin
Add(elError, AMessage, ANode);
end;
procedure TCapturingLog.AddWarning(const AMessage: string; const ANode: IAstNode);
begin
// Ignore warnings for tests
end;
function TCapturingLog.GetEntries: TArray<TCompilerError>;
begin
Result := nil;
end;
function TCapturingLog.GetEntryCount: Integer;
begin
Result := FErrors.Count;
end;
function TCapturingLog.HasErrors: Boolean;
begin
Result := FErrors.Count > 0;
end;
{ TDataCollector }
constructor TDataCollector.Create(AStream: IStream);
begin
FStream := AStream;
FSignalCount := 0;
FLastRecord := nil;
end;
procedure TDataCollector.OnSignal(const Signal: TStreamSignal);
var
scalarVal: TScalar;
begin
if Signal.Kind = skData then
begin
Inc(FSignalCount);
// Grab the latest item from the series
if FStream.Series.Count > 0 then
begin
scalarVal := FStream.Series.Items[FStream.Series.Count - 1];
// FIX: Cast TScalar to TDataValue to access AsScalarRecord
FLastRecord := TDataValue(scalarVal).AsScalarRecord;
end;
end;
end;
{ TPipeIntegrationTests }
procedure TPipeIntegrationTests.Setup;
begin
FGraph := TGraphExecutor.Create;
FLog := TCapturingLog.Create;
SetupHostEnvironment;
end;
procedure TPipeIntegrationTests.Teardown;
begin
FGraph := nil; // Interfaces release automatically
FLog.Free; // Class implementation needs free (ref counting mixed usage)
end;
procedure TPipeIntegrationTests.SetupHostEnvironment;
var
btcDef: IScalarRecordDefinition;
btcType: IStaticType;
typeDesc: IScopeDescriptor;
btcSlot: Integer;
scopeBuilder: IScopeBuilder;
begin
// 1. Create the physical Input Channel in the Graph
// FIX: Use TKeywordRegistry.Intern for Keywords
// FIX: Using TScalarRecordDefinition class (check if renamed to TRecordDef in your codebase)
btcDef :=
TScalarRecordDefinition.Create(
[
TScalarRecordField.Create(TKeywordRegistry.Intern('Close'), skInt64),
TScalarRecordField.Create(TKeywordRegistry.Intern('Open'), skInt64)
]
);
FInputChannel := FGraph.GetInputChannel('btc', btcDef);
// 2. Prepare the Compiler Environment (Symbol Table)
// FIX: Use Builder to define symbols
scopeBuilder := TScope.CreateBuilder(nil);
btcSlot := scopeBuilder.Define('btc');
FRootLayout := scopeBuilder.Build;
// 3. Prepare Type Information
// Tell the TypeChecker that 'btc' is a RecordSeries with Open/Close fields
btcType := TTypes.CreateRecordSeries(btcDef);
typeDesc := TScope.CreateDescriptor(FRootLayout, [btcType]);
// 4. Prepare Runtime Scope
// Create scope and inject the actual Stream object into slot 0
FRootScope := TScope.CreateScope(nil, typeDesc, nil);
FRootScope.DefineBoxed(btcSlot, TDataValue.FromStream(FInputChannel.Stream));
end;
function TPipeIntegrationTests.CompileAndRun(const Source: string): IStream;
var
rawAst, boundAst, typedAst: IAstNode;
evaluator: IEvaluatorVisitor;
res: TDataValue;
begin
// 1. Parse
try
rawAst := TAstScript.Parse(Source);
except
on E: Exception do
Assert.Fail('Parsing failed: ' + E.Message);
end;
// 2. Bind
boundAst := TAstBinder.Bind(FRootLayout, rawAst, FRootLayout, FLog);
if FLog.HasErrors then
Assert.Fail('Binding failed: ' + FLog.Errors[0]);
// 3. TypeCheck
typedAst := TTypeChecker.CheckTypes(boundAst, FRootLayout, FRootScope, FLog);
if FLog.HasErrors then
Assert.Fail('TypeCheck failed: ' + FLog.Errors[0]);
// 4. Evaluate
evaluator := TEvaluatorVisitor.Create(FRootScope);
res := evaluator.Execute(typedAst);
Assert.AreEqual(vkStream, res.Kind, 'Evaluation did not return a Stream');
Result := res.AsStream;
end;
procedure TPipeIntegrationTests.Test_Simple_Pipe_Throughput;
var
pipeStream: IStream;
observer: TDataCollector;
inputData: IKeywordMapping<TScalar>;
begin
// A simple pipe that just passes 'Close' through as 'Val'
var source := '(pipe [btc [:Close]] (fn [c] { :Val c }))';
pipeStream := CompileAndRun(source);
// Attach Observer
observer := TDataCollector.Create(pipeStream);
pipeStream.Subscribe(observer);
// --- Step 1: Input 100 ---
inputData := TKeywordMapping<TScalar>.Create([TPair<IKeyword, TScalar>.Create(TKeywordRegistry.Intern('Close'), 100)]);
FInputChannel.Push(inputData);
FGraph.Step;
// Assertions
Assert.AreEqual(1, observer.SignalCount, 'Should have received 1 signal');
Assert.IsNotNull(observer.LastRecord, 'Record should not be nil');
Assert.AreEqual(Int64(100), observer.LastRecord.Fields[TKeywordRegistry.Intern('Val')].Value.AsInt64, 'Output Value wrong');
// --- Step 2: Input 200 ---
inputData := TKeywordMapping<TScalar>.Create([TPair<IKeyword, TScalar>.Create(TKeywordRegistry.Intern('Close'), 200)]);
FInputChannel.Push(inputData);
FGraph.Step;
Assert.AreEqual(2, observer.SignalCount);
Assert.AreEqual(Int64(200), observer.LastRecord.Fields[TKeywordRegistry.Intern('Val')].Value.AsInt64);
end;
procedure TPipeIntegrationTests.Test_Pipe_Field_Mapping_And_Calculation;
var
pipeStream: IStream;
observer: TDataCollector;
inputData: IKeywordMapping<TScalar>;
begin
// A pipe that takes Open and Close, calculates the delta, and renames fields
// fn params: o -> Open, c -> Close
var source := '(pipe [btc [:Open :Close]] (fn [o c] { :Delta (- c o) :Original c }))';
pipeStream := CompileAndRun(source);
observer := TDataCollector.Create(pipeStream);
pipeStream.Subscribe(observer);
// Input: Open=100, Close=110 -> Delta should be 10
inputData :=
TKeywordMapping<TScalar>.Create(
[
TPair<IKeyword, TScalar>.Create(TKeywordRegistry.Intern('Open'), 100),
TPair<IKeyword, TScalar>.Create(TKeywordRegistry.Intern('Close'), 110)
]
);
FInputChannel.Push(inputData);
FGraph.Step;
Assert.AreEqual(1, observer.SignalCount);
var delta := observer.LastRecord.Fields[TKeywordRegistry.Intern('Delta')].Value.AsInt64;
var orig := observer.LastRecord.Fields[TKeywordRegistry.Intern('Original')].Value.AsInt64;
Assert.AreEqual(Int64(10), delta, 'Delta calculation wrong');
Assert.AreEqual(Int64(110), orig, 'Original value passthrough wrong');
end;
initialization
TDUnitX.RegisterTestFixture(TPipeIntegrationTests);
end.
Test/MycTests.dpr
+3 -1
View File
@@ -34,7 +34,9 @@ uses
Test.Myc.Ast.RTL.DateTime in 'AST\Test.Myc.Ast.RTL.DateTime.pas',
Test.Myc.Ast.Compiler.Binder in '..\Src\AST\Test.Myc.Ast.Compiler.Binder.pas',
Test.Myc.Ast.RTL.TypeRegistry in 'AST\Test.Myc.Ast.RTL.TypeRegistry.pas',
Test.Myc.Ast.NullPropagation in 'AST\Test.Myc.Ast.NullPropagation.pas';
Test.Myc.Ast.NullPropagation in 'AST\Test.Myc.Ast.NullPropagation.pas',
Test.Myc.Ast.Pipes in 'AST\Test.Myc.Ast.Pipes.pas',
Test.Myc.Ast.Integration in 'Test.Myc.Ast.Integration.pas';
{ keep comment here to protect the following conditional from being removed by the IDE when adding a unit }
{$IFNDEF TESTINSIGHT}
Test/MycTests.dproj
+2
View File
@@ -136,6 +136,8 @@ $(PreBuildEvent)]]></PreBuildEvent>
<DCCReference Include="..\Src\AST\Test.Myc.Ast.Compiler.Binder.pas"/>
<DCCReference Include="AST\Test.Myc.Ast.RTL.TypeRegistry.pas"/>
<DCCReference Include="AST\Test.Myc.Ast.NullPropagation.pas"/>
<DCCReference Include="AST\Test.Myc.Ast.Pipes.pas"/>
<DCCReference Include="Test.Myc.Ast.Integration.pas"/>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>
Test/Scripts/TCO1.txt
+9
View File
@@ -0,0 +1,9 @@
;; EXPECT: "done"
;; TYPE: vkText
(do
(def count-down (fn [n]
(if (= n 0)
"done"
(recur (- n 1)))))
(count-down 100000)
)
Test/Scripts/Test1.txt
+3
View File
@@ -0,0 +1,3 @@
;; EXPECT: 25
;; TYPE: vkScalar
(+ 10 15)
Test/Scripts/fn1.txt
+4
View File
@@ -0,0 +1,4 @@
;; EXPECT: <method>
;; TYPE: vkMethod
;; SIGNATURE: Method(Unknown): Unknown
(fn [n] (do n))
Test/Test.Myc.Ast.Integration.pas
+215
View File
@@ -0,0 +1,215 @@
unit Test.Myc.Ast.Integration;
interface
uses
System.SysUtils,
System.Classes,
System.IOUtils,
System.TypInfo,
System.Generics.Collections,
DUnitX.TestFramework,
// Core
Myc.Data.Value,
Myc.Ast.Environment,
Myc.Ast.Script,
Myc.Ast.Nodes; // For Exception handling
type
[TestFixture]
TTestIntegration = class
private
const
TEST_DIR = 'T:\Myc\Test\Scripts';
procedure RunSingleScript(const FileName: string);
function ParseKind(const KindStr: string): TDataValueKind;
public
[Setup]
procedure Setup;
[Test]
[IgnoreMemoryLeaks]
procedure RunAllFileBasedTests;
end;
implementation
{ TTestIntegration }
procedure TTestIntegration.Setup;
begin
// Ensure the directory exists to avoid immediate crash
if not TDirectory.Exists(TEST_DIR) then
ForceDirectories(TEST_DIR);
end;
function TTestIntegration.ParseKind(const KindStr: string): TDataValueKind;
var
I: Integer;
begin
// Uses RTTI/TypInfo to convert string 'vkScalar' to enum TDataValueKind.vkScalar
I := GetEnumValue(TypeInfo(TDataValueKind), KindStr);
if I < 0 then
raise Exception.CreateFmt('Unknown TDataValueKind in test header: %s', [KindStr]);
Result := TDataValueKind(I);
end;
procedure TTestIntegration.RunSingleScript(const FileName: string);
var
Lines: TArray<string>;
ScriptSource: TStringBuilder;
ExpectedOutput, ExpectedSignature: string; // <-- Neu
ExpectedTypeStr: string;
ExpectedType: TDataValueKind;
HasExpectation: Boolean;
Line: string;
Env: TAstEnvironment;
ResultValue: TDataValue;
// AST Variablen für die Analyse
RootNode, BoundNode, SpecializedNode: IAstNode;
ActualSignature: string;
begin
Lines := TFile.ReadAllLines(FileName);
ScriptSource := TStringBuilder.Create;
try
ExpectedOutput := '';
ExpectedSignature := ''; // <-- Init
ExpectedTypeStr := '';
ExpectedType := TDataValueKind.vkVoid;
HasExpectation := False;
// 1. Parsing (angepasst für SIGNATURE)
for Line in Lines do
begin
if Line.Trim.StartsWith(';; EXPECT:') then
begin
ExpectedOutput := Line.Substring(10).Trim;
HasExpectation := True;
end
else if Line.Trim.StartsWith(';; TYPE:') then
begin
ExpectedTypeStr := Line.Substring(8).Trim;
ExpectedType := ParseKind(ExpectedTypeStr);
end
else if Line.Trim.StartsWith(';; SIGNATURE:') then // <-- Neu
begin
ExpectedSignature := Line.Substring(13).Trim;
end
else
begin
ScriptSource.AppendLine(Line);
end;
end;
if not HasExpectation then
Assert.Fail('Test file missing ";; EXPECT:" tag: ' + FileName);
// 2. Environment Setup
Env := TAstEnvironment.Construct(nil);
Env.SetStandardMode;
// 3. Parse AST
RootNode := TAstScript.Parse(ScriptSource.ToString);
// --- SIGNATURE CHECK START ---
if ExpectedSignature <> '' then
begin
try
// Wir simulieren die Pipeline bis zum Type-Check
// Hinweis: Env.Bind führt intern oft schon Namensauflösung und TypeCheck durch.
// Env.Specialize löst generische Aufrufe auf und finalisiert Typen.
// A. Bind (Namensauflösung & TypeCheck)
// Wir übergeben einen Dummy-Log, oder nil wenn erlaubt
BoundNode := Env.Bind(RootNode, [], nil);
// B. Specialize (Optimierung & finale Typisierung)
SpecializedNode := Env.Specialize(BoundNode);
// C. Typ extrahieren
if SpecializedNode.IsTyped then
begin
ActualSignature := SpecializedNode.AsTypedNode.StaticType.ToString;
Assert
.AreEqual(ExpectedSignature, ActualSignature, Format('File: %s - Signature Mismatch', [ExtractFileName(FileName)]));
end
else
begin
Assert.Fail(Format('File: %s - Root node is not typed, cannot check signature.', [ExtractFileName(FileName)]));
end;
except
on E: Exception do
begin
Assert.Fail(Format('File: %s - Compilation/TypeCheck failed: %s', [ExtractFileName(FileName), E.Message]));
end;
end;
end;
// --- SIGNATURE CHECK END ---
try
// 4. Run Execution (Value Check)
// Wir nutzen hier wieder RootNode (oder SpecializedNode, falls Env.Run damit umgehen kann),
// um sicherzustellen, dass die Ausführung sauber durchläuft.
ResultValue := Env.Run(RootNode);
// 5. Verify Type
if ExpectedTypeStr <> '' then
begin
Assert.AreEqual(ExpectedType, ResultValue.Kind, Format('File: %s - Result Type Mismatch', [ExtractFileName(FileName)]));
end;
// 6. Verify Output Value
Assert.AreEqual(ExpectedOutput, ResultValue.ToString, Format('File: %s - Result Value Mismatch', [ExtractFileName(FileName)]));
except
on E: EAssertionFailed do
raise;
on E: Exception do
Assert.Fail(Format('File: %s - Exception during execution: %s', [ExtractFileName(FileName), E.Message]));
end;
finally
ScriptSource.Free;
end;
end;
procedure TTestIntegration.RunAllFileBasedTests;
var
Files: TArray<string>;
FileName: string;
Failures: TStringBuilder;
begin
Files := TDirectory.GetFiles(TEST_DIR, '*.txt');
if Length(Files) = 0 then
Exit; // Silent exit if no files found (success, effectively)
Failures := TStringBuilder.Create;
try
for FileName in Files do
begin
try
RunSingleScript(FileName);
except
on E: Exception do
begin
Failures.AppendLine(Format('[FAIL] %s: %s', [ExtractFileName(FileName), E.Message]));
end;
end;
end;
// Only fail if errors were collected
if Failures.Length > 0 then
Assert.Fail('One or more integration scripts failed:' + SLineBreak + Failures.ToString);
finally
Failures.Free;
end;
end;
end.