diff --git a/ASTPlayground/MainForm.fmx b/ASTPlayground/MainForm.fmx index b2df71f..6a31876 100644 --- a/ASTPlayground/MainForm.fmx +++ b/ASTPlayground/MainForm.fmx @@ -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 diff --git a/ASTPlayground/MainForm.pas b/ASTPlayground/MainForm.pas index 5adf589..6db6229 100644 --- a/ASTPlayground/MainForm.pas +++ b/ASTPlayground/MainForm.pas @@ -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); diff --git a/Src/AST/Myc.Ast.Compiler.Binder.pas b/Src/AST/Myc.Ast.Compiler.Binder.pas index 6e789d8..0794425 100644 --- a/Src/AST/Myc.Ast.Compiler.Binder.pas +++ b/Src/AST/Myc.Ast.Compiler.Binder.pas @@ -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; 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(''); - // 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; diff --git a/Src/AST/Myc.Ast.Compiler.TypeChecker.pas b/Src/AST/Myc.Ast.Compiler.TypeChecker.pas index f454fbb..bba3856 100644 --- a/Src/AST/Myc.Ast.Compiler.TypeChecker.pas +++ b/Src/AST/Myc.Ast.Compiler.TypeChecker.pas @@ -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; - 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; - 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; + 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; @@ -434,72 +404,57 @@ var bodyType, methodType: IStaticType; paramTypes: TArray; upvalueTypes: TArray; - upvalueAddrs: TArray; 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); - end; + Dec(lookupAddr.ScopeDepth); 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; 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; - 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; - 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 - 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; - - newElse := Accept(Node.ElseBranch); - var elseType := newElse.AsTypedNode.StaticType; - - if resultType = nil then - resultType := elseType + // Simple promotion logic + if (newElse <> nil) then + resType := TTypeRules.Promote(newThen.AsTypedNode.StaticType, newElse.AsTypedNode.StaticType) 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; + resType := TTypes.MakeOptional(newThen.AsTypedNode.StaticType); - 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; - def: IScalarRecordDefinition; - staticType: IStaticType; - valType: IStaticType; - scalarKind: TScalar.TKind; - allScalar: Boolean; newFields: TArray; + fieldTypes: TArray>; + scalarFieldTypes: TArray>; + 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 - else - newFields[i] := TAst.RecordField(field.Identity, newKey, newValue); - end; + // Keys are guaranteed to be keywords by parser + key := oldField.Key.Value; - SetLength(scalarDefFields, Length(newFields)); - allScalar := True; + // Recreate the field node with the typed value + newFields[i] := TAst.RecordField(oldField.Identity, oldField.Key, visitedValue); - for i := 0 to High(newFields) do - begin - valType := newFields[i].Value.AsTypedNode.StaticType; + // Analyze Type + valType := visitedValue.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 + // 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 + kind := TScalar.TKind.Ordinal; // Should not happen given check above + end; + scalarFieldTypes[i] := TPair.Create(key, kind); + end else begin - allScalar := False; - scalarKind := TScalar.TKind.Ordinal; + isScalar := False; end; - if allScalar then - scalarDefFields[i] := TScalarRecordField.Create(newFields[i].Key.Value, scalarKind); + fieldTypes[i] := TPair.Create(key, valType); end; - var fieldList := TRecordFieldList.Create(newFields, Node.Fields.Identity); + // Build Definition + var scalarDef: IScalarRecordDefinition := nil; + var genericDef: IGenericRecordDefinition := nil; + var resultType: IStaticType; - if allScalar then + if isScalar and (Length(newFields) > 0) then begin - def := TScalarRecord.TRegistry.Intern(scalarDefFields); - staticType := TTypes.CreateRecord(def); - Result := TAst.RecordLiteral(Node.Identity, fieldList, def, nil, staticType); + scalarDef := TKeywordMappingRegistry.Intern(scalarFieldTypes); + resultType := TTypes.CreateRecord(scalarDef); end else begin - var genDefFields: TArray>; - SetLength(genDefFields, Length(newFields)); - for i := 0 to High(newFields) do - genDefFields[i] := TPair.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); + 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; + 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 Assigned(FLog) then - FLog.AddError(Format('"length" requires a series, but got %s', [seriesType.ToString]), Node); + if not ((sourceType.Kind = stSeries) or (sourceType.Kind = stRecordSeries)) then + begin + if Assigned(FLog) then + 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; + streamType: IStaticType; + paramTypes: TList; + lambda: ILambdaExpressionNode; + newParams: TArray; + inferredType: IStaticType; +begin + SetLength(newInputs, Node.Inputs.Count); + paramTypes := TList.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. diff --git a/Src/AST/Myc.Ast.Debugger.pas b/Src/AST/Myc.Ast.Debugger.pas index a5d7137..70c1824 100644 --- a/Src/AST/Myc.Ast.Debugger.pas +++ b/Src/AST/Myc.Ast.Debugger.pas @@ -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. diff --git a/Src/AST/Myc.Ast.Environment.pas b/Src/AST/Myc.Ast.Environment.pas index baa15e9..5c7e602 100644 --- a/Src/AST/Myc.Ast.Environment.pas +++ b/Src/AST/Myc.Ast.Environment.pas @@ -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; diff --git a/Src/AST/Myc.Ast.Evaluator.pas b/Src/AST/Myc.Ast.Evaluator.pas index 84d0304..be6332e 100644 --- a/Src/AST/Myc.Ast.Evaluator.pas +++ b/Src/AST/Myc.Ast.Evaluator.pas @@ -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; + 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; + 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. diff --git a/Src/AST/Myc.Ast.RTL.Core.pas b/Src/AST/Myc.Ast.RTL.Core.pas index 01f1288..752fa98 100644 --- a/Src/AST/Myc.Ast.RTL.Core.pas +++ b/Src/AST/Myc.Ast.RTL.Core.pas @@ -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; overload; static; - [TRtlExport('-')] + [TRtlExport('-', Pure)] class function Subtract(const Args: TArray): TDataValue; static; - [TRtlExport('*')] + [TRtlExport('*', Pure)] class function Multiply(const Args: TArray): TDataValue; static; - [TRtlExport('/')] + [TRtlExport('/', Pure)] class function Divide(const Args: TArray): TDataValue; static; - [TRtlExport('div')] + [TRtlExport('div', Pure)] class function IntDivide(const Args: TArray): TDataValue; static; - [TRtlExport('mod')] + [TRtlExport('mod', Pure)] class function Modulus(const Args: TArray): TDataValue; static; // Comparison - [TRtlExport('=')] + [TRtlExport('=', Impure)] class function Equal(const Args: TArray): TDataValue; static; - [TRtlExport('<>')] + [TRtlExport('<>', Impure)] class function NotEqual(const Args: TArray): TDataValue; static; - [TRtlExport('<')] + [TRtlExport('<', Impure)] class function LessThan(const Args: TArray): TDataValue; static; - [TRtlExport('<=')] + [TRtlExport('<=', Impure)] class function LessThanOrEqual(const Args: TArray): TDataValue; static; - [TRtlExport('>')] + [TRtlExport('>', Impure)] class function GreaterThan(const Args: TArray): TDataValue; static; - [TRtlExport('>=')] + [TRtlExport('>=', Impure)] class function GreaterThanOrEqual(const Args: TArray): TDataValue; static; // Logic / Bitwise - [TRtlExport('not')] + [TRtlExport('not', Impure)] class function LogicalNot(const Args: TArray): TDataValue; static; - [TRtlExport('and')] + [TRtlExport('and', Impure)] class function BitwiseAnd(const Args: TArray): TDataValue; static; - [TRtlExport('or')] + [TRtlExport('or', Impure)] class function BitwiseOr(const Args: TArray): TDataValue; static; - [TRtlExport('xor')] + [TRtlExport('xor', Impure)] class function BitwiseXor(const Args: TArray): TDataValue; static; - [TRtlExport('shl')] + [TRtlExport('shl', Impure)] class function LeftShift(const Args: TArray): TDataValue; static; - [TRtlExport('shr')] + [TRtlExport('shr', Impure)] class function RightShift(const Args: TArray): 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; static; - [TRtlExport('Date')] + [TRtlExport('Date', Impure)] class function Date(const Args: TArray): TDataValue; static; // (* Other dynamic functions *) - [TRtlExport('Memoize')] + [TRtlExport('Memoize', Impure)] class function Memoize(const Args: TArray): TDataValue; static; - [TRtlExport('Map')] + [TRtlExport('Map', Impure)] class function Map(const Args: TArray): TDataValue; static; - [TRtlExport('Reduce')] + [TRtlExport('Reduce', Impure)] class function Reduce(const Args: TArray): TDataValue; static; - [TRtlExport('Where')] + [TRtlExport('Where', Impure)] class function Where(const Args: TArray): TDataValue; static; - [TRtlExport('Any')] + [TRtlExport('Any', Impure)] class function Any(const Args: TArray): 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 } diff --git a/Src/AST/Myc.Ast.RTL.pas b/Src/AST/Myc.Ast.RTL.pas index f8962c9..d710932 100644 --- a/Src/AST/Myc.Ast.RTL.pas +++ b/Src/AST/Myc.Ast.RTL.pas @@ -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 } diff --git a/Src/AST/Myc.Ast.Visitor.pas b/Src/AST/Myc.Ast.Visitor.pas index ad41787..41aa091 100644 --- a/Src/AST/Myc.Ast.Visitor.pas +++ b/Src/AST/Myc.Ast.Visitor.pas @@ -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; diff --git a/Src/Data/Myc.Data.Scalar.pas b/Src/Data/Myc.Data.Scalar.pas index 509cff2..f07b7c4 100644 --- a/Src/Data/Myc.Data.Scalar.pas +++ b/Src/Data/Myc.Data.Scalar.pas @@ -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) {$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; 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); diff --git a/Src/Data/Myc.Data.Stream.pas b/Src/Data/Myc.Data.Stream.pas index 5c8c180..30d5fcb 100644 --- a/Src/Data/Myc.Data.Stream.pas +++ b/Src/Data/Myc.Data.Stream.pas @@ -9,7 +9,6 @@ uses System.SyncObjs, Myc.Data.Scalar, Myc.Data.Keyword, - Myc.Data.Value, Myc.Core.Notifier; type diff --git a/Src/Data/Myc.Data.Value.pas b/Src/Data/Myc.Data.Value.pas index c52e4a3..b5ff2e8 100644 --- a/Src/Data/Myc.Data.Value.pas +++ b/Src/Data/Myc.Data.Value.pas @@ -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; 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 := ''; vkVoid: Result := ''; vkMethod: Result := ''; vkGeneric: Result := ''; diff --git a/Test/AST/Test.Myc.Ast.Compiler.Macros.pas b/Test/AST/Test.Myc.Ast.Compiler.Macros.pas index 41b766d..2af4688 100644 --- a/Test/AST/Test.Myc.Ast.Compiler.Macros.pas +++ b/Test/AST/Test.Myc.Ast.Compiler.Macros.pas @@ -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] diff --git a/Test/AST/Test.Myc.Ast.NullPropagation.pas b/Test/AST/Test.Myc.Ast.NullPropagation.pas index 6d99aaa..c83cc6c 100644 --- a/Test/AST/Test.Myc.Ast.NullPropagation.pas +++ b/Test/AST/Test.Myc.Ast.NullPropagation.pas @@ -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] diff --git a/Test/AST/Test.Myc.Ast.Pipes.pas b/Test/AST/Test.Myc.Ast.Pipes.pas new file mode 100644 index 0000000..0112305 --- /dev/null +++ b/Test/AST/Test.Myc.Ast.Pipes.pas @@ -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; + 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 + ): 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.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; +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 +): IWriteableScalarRecordSeries; +var + fields: TArray; + def: IScalarRecordDefinition; + i: Integer; + val: TScalar.TValue; + recValues: TArray; +begin + SetLength(fields, 1); + fields[0] := TScalarRecordField.Create(TKeywordRegistry.Intern(FieldName), Kind); + def := TKeywordMappingRegistry.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. diff --git a/Test/AST/Test.Myc.Ast.Stream.Pipes.pas b/Test/AST/Test.Myc.Ast.Stream.Pipes.pas new file mode 100644 index 0000000..7f37b73 --- /dev/null +++ b/Test/AST/Test.Myc.Ast.Stream.Pipes.pas @@ -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; + 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; + property Errors: TList 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.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; +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; +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.Create([TPair.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.Create([TPair.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; +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.Create( + [ + TPair.Create(TKeywordRegistry.Intern('Open'), 100), + TPair.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. diff --git a/Test/MycTests.dpr b/Test/MycTests.dpr index 32958f5..8fbb6f9 100644 --- a/Test/MycTests.dpr +++ b/Test/MycTests.dpr @@ -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} diff --git a/Test/MycTests.dproj b/Test/MycTests.dproj index 9c8069a..4e99d44 100644 --- a/Test/MycTests.dproj +++ b/Test/MycTests.dproj @@ -136,6 +136,8 @@ $(PreBuildEvent)]]> + + Base diff --git a/Test/Scripts/TCO1.txt b/Test/Scripts/TCO1.txt new file mode 100644 index 0000000..f44edba --- /dev/null +++ b/Test/Scripts/TCO1.txt @@ -0,0 +1,9 @@ +;; EXPECT: "done" +;; TYPE: vkText +(do +(def count-down (fn [n] + (if (= n 0) + "done" + (recur (- n 1))))) +(count-down 100000) +) \ No newline at end of file diff --git a/Test/Scripts/Test1.txt b/Test/Scripts/Test1.txt new file mode 100644 index 0000000..aa89662 --- /dev/null +++ b/Test/Scripts/Test1.txt @@ -0,0 +1,3 @@ +;; EXPECT: 25 +;; TYPE: vkScalar +(+ 10 15) \ No newline at end of file diff --git a/Test/Scripts/fn1.txt b/Test/Scripts/fn1.txt new file mode 100644 index 0000000..50c6963 --- /dev/null +++ b/Test/Scripts/fn1.txt @@ -0,0 +1,4 @@ +;; EXPECT: +;; TYPE: vkMethod +;; SIGNATURE: Method(Unknown): Unknown +(fn [n] (do n)) diff --git a/Test/Test.Myc.Ast.Integration.pas b/Test/Test.Myc.Ast.Integration.pas new file mode 100644 index 0000000..e90f676 --- /dev/null +++ b/Test/Test.Myc.Ast.Integration.pas @@ -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; + 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; + 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.