From 6b77391e91f48377b3e5bc7b3f18eb9002be1718 Mon Sep 17 00:00:00 2001 From: Michael Schimmel Date: Fri, 5 Sep 2025 21:00:07 +0200 Subject: [PATCH] Refactoring + Panning in Workspace --- ASTPlayground/Myc.Ast.Visualizer.pas | 152 ++++++++++++++++++++++++--- Src/AST/Myc.Ast.Evaluator.pas | 141 +++++++------------------ Src/AST/Myc.Ast.Nodes.pas | 19 ++-- Src/AST/Myc.Ast.Printer.pas | 2 +- Src/AST/Myc.Ast.pas | 24 ++--- Src/Data/Myc.Data.Scalar.pas | 60 +++++++++++ 6 files changed, 253 insertions(+), 145 deletions(-) diff --git a/ASTPlayground/Myc.Ast.Visualizer.pas b/ASTPlayground/Myc.Ast.Visualizer.pas index 6785147..82a1bc0 100644 --- a/ASTPlayground/Myc.Ast.Visualizer.pas +++ b/ASTPlayground/Myc.Ast.Visualizer.pas @@ -7,6 +7,7 @@ uses System.Classes, System.UITypes, System.Types, + System.Math.Vectors, System.Generics.Collections, FMX.Types, FMX.Controls, @@ -114,11 +115,26 @@ type TAuraWorkspace = class(TStyledControl) private FConnections: TArray; + // If the mouse is dragging the background (i.e., no child control is being dragged), + // then FPanning should be dragged. + FPanning: TSizeF; + // Added for panning implementation. + FIsPanning: Boolean; + FLastPanPos: TPointF; + // Added for zooming implementation. + FZoom: Single; protected procedure Paint; override; procedure DoDeleteChildren; override; + // Add a zoom factor that, along with FPanning, zooms the children via the mouse wheel. + procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override; + procedure MouseMove(Shift: TShiftState; X, Y: Single); override; + procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override; + procedure MouseWheel(Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean); override; public + constructor Create(AOwner: TComponent); override; procedure BuildTree(const Root: IAstNode; const Position: TPointF; AMode: TVisualizationMode); + function GetChildrenMatrix(var Matrix: TMatrix; var Simple: Boolean): Boolean; override; published // Standard control properties @@ -267,6 +283,7 @@ implementation uses System.Math, System.StrUtils, + FMX.Platform, Myc.Data.Scalar; type @@ -303,34 +320,34 @@ begin lookbackStr := ''; if Assigned(Node.Lookback) then lookbackStr := ', ' + Node.Lookback.Accept(Self).AsText; - Result := TAstValue.FromText(Format('%s.add(%s%s)', [seriesStr, valueStr, lookbackStr])); + Result := Format('%s.add(%s%s)', [seriesStr, valueStr, lookbackStr]); end; function TAstToTextVisitor.VisitAssignment(const Node: IAssignmentNode): TAstValue; begin - Result := TAstValue.FromText(Node.Identifier.Name + ' := ' + Node.Value.Accept(Self).AsText); + Result := Node.Identifier.Name + ' := ' + Node.Value.Accept(Self).AsText; end; function TAstToTextVisitor.VisitBinaryExpression(const Node: IBinaryExpressionNode): TAstValue; begin var leftStr := Node.Left.Accept(Self).AsText; var rightStr := Node.Right.Accept(Self).AsText; - Result := TAstValue.FromText('(' + leftStr + ' ' + Node.Operator.ToString + ' ' + rightStr + ')'); + Result := '(' + leftStr + ' ' + Node.Operator.ToString + ' ' + rightStr + ')'; end; function TAstToTextVisitor.VisitBlockExpression(const Node: IBlockExpressionNode): TAstValue; begin - Result := TAstValue.FromText('{...}'); + Result := '{...}'; end; function TAstToTextVisitor.VisitConstant(const Node: IConstantNode): TAstValue; begin - Result := TAstValue.FromText(Node.Value.ToString); + Result := Node.Value.ToString; end; function TAstToTextVisitor.VisitCreateSeries(const Node: ICreateSeriesNode): TAstValue; begin - Result := TAstValue.FromText('new series(' + Node.Definition + ')'); + Result := 'new series(' + Node.Definition + ')'; end; function TAstToTextVisitor.VisitFunctionCall(const Node: IFunctionCallNode): TAstValue; @@ -352,7 +369,7 @@ begin sb.Append(', '); end; sb.Append(')'); - Result := TAstValue.FromText(sb.ToString); + Result := sb.ToString; finally sb.Free; end; @@ -360,12 +377,12 @@ end; function TAstToTextVisitor.VisitIdentifier(const Node: IIdentifierNode): TAstValue; begin - Result := TAstValue.FromText(Node.Name); + Result := Node.Name; end; function TAstToTextVisitor.VisitIfExpression(const Node: IIfExpressionNode): TAstValue; begin - Result := TAstValue.FromText(Node.Condition.Accept(Self).AsText); + Result := Node.Condition.Accept(Self).AsText; end; function TAstToTextVisitor.VisitIndexer(const Node: IIndexerNode): TAstValue; @@ -374,7 +391,7 @@ var begin baseStr := Node.Base.Accept(Self).AsText; indexStr := Node.Index.Accept(Self).AsText; - Result := TAstValue.FromText(Format('%s[%s]', [baseStr, indexStr])); + Result := Format('%s[%s]', [baseStr, indexStr]); end; function TAstToTextVisitor.VisitLambdaExpression(const Node: ILambdaExpressionNode): TAstValue; @@ -396,7 +413,7 @@ begin end; end; sb.Append(') => {...}'); - Result := TAstValue.FromText(sb.ToString); + Result := sb.ToString; finally sb.Free; end; @@ -407,7 +424,7 @@ var baseStr: string; begin baseStr := Node.Base.Accept(Self).AsText; - Result := TAstValue.FromText(Format('%s.%s', [baseStr, Node.Member.Name])); + Result := Format('%s.%s', [baseStr, Node.Member.Name]); end; function TAstToTextVisitor.VisitSeriesLength(const Node: ISeriesLengthNode): TAstValue; @@ -416,7 +433,7 @@ var begin // Get the string representation of the series identifier by visiting the node. seriesStr := Node.Series.Accept(Self).AsText; - Result := TAstValue.FromText(Format('length(%s)', [seriesStr])); + Result := Format('length(%s)', [seriesStr]); end; function TAstToTextVisitor.VisitTernaryExpression(const Node: ITernaryExpressionNode): TAstValue; @@ -424,12 +441,12 @@ begin var condStr := Node.Condition.Accept(Self).AsText; var thenStr := Node.ThenBranch.Accept(Self).AsText; var elseStr := Node.ElseBranch.Accept(Self).AsText; - Result := TAstValue.FromText(Format('(%s ? %s : %s)', [condStr, thenStr, elseStr])); + Result := Format('(%s ? %s : %s)', [condStr, thenStr, elseStr]); end; function TAstToTextVisitor.VisitUnaryExpression(const Node: IUnaryExpressionNode): TAstValue; begin - Result := TAstValue.FromText(Node.Operator.ToString + ' ' + Node.Right.Accept(Self).AsText); + Result := Node.Operator.ToString + ' ' + Node.Right.Accept(Self).AsText; end; function TAstToTextVisitor.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TAstValue; @@ -440,7 +457,7 @@ begin initStr := ' := ' + Node.Initializer.Accept(Self).AsText else initStr := ''; - Result := TAstValue.FromText('var ' + Node.Identifier.Name + initStr); + Result := 'var ' + Node.Identifier.Name + initStr; end; { TPinConnection } @@ -479,7 +496,7 @@ begin Height := 45; // The panel must be able to receive mouse events. - HitTest := True; + // HitTest := True; // Clip children to the panel's bounds. ClipChildren := True; end; @@ -619,6 +636,7 @@ begin begin FIsDragging := True; FDownPos := TPointF.Create(X, Y); + Capture; end; end; end; @@ -626,6 +644,7 @@ end; procedure TAuraNode.MouseMove(Shift: TShiftState; X, Y: Single); begin inherited; + if FIsDragging then begin var deltaX := X - FDownPos.X; @@ -644,12 +663,20 @@ begin inherited; if (Button = TMouseButton.mbLeft) and (FIsDragging) then begin + ReleaseCapture; FIsDragging := False; end; end; { TAuraWorkspace } +constructor TAuraWorkspace.Create(AOwner: TComponent); +begin + inherited; + // Initialize zoom factor. + FZoom := 1.0; +end; + procedure TAuraWorkspace.BuildTree(const Root: IAstNode; const Position: TPointF; AMode: TVisualizationMode); begin var connections := TList.Create; @@ -667,6 +694,97 @@ begin inherited; end; +function TAuraWorkspace.GetChildrenMatrix(var Matrix: TMatrix; var Simple: Boolean): Boolean; +begin + // Combine scaling (zoom) and translation (pan) into a single matrix. + // The order is important: scale first, then translate. + Matrix := TMatrix.CreateScaling(FZoom, FZoom) * TMatrix.CreateTranslation(FPanning.cx, FPanning.cy); + Simple := (FZoom = 1.0) and (FPanning.cx = 0) and (FPanning.cy = 0); + Result := true; +end; + +procedure TAuraWorkspace.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single); +begin + inherited; + // Start panning if left button is pressed on the background + if (Button = TMouseButton.mbLeft) and (ObjectAtPoint(LocalToScreen(TPointF.Create(X, Y))) = Self as IControl) then + begin + FIsPanning := True; + FLastPanPos := TPointF.Create(X, Y); + Cursor := crHandPoint; + end; +end; + +procedure TAuraWorkspace.MouseMove(Shift: TShiftState; X, Y: Single); +var + delta: TPointF; +begin + inherited; + + if FIsPanning then + begin + // Calculate movement delta + delta := TPointF.Create(X - FLastPanPos.X, Y - FLastPanPos.Y); + + // Update panning offset + FPanning.cx := FPanning.cx + delta.X; + FPanning.cy := FPanning.cy + delta.Y; + + // Store current position for next move + FLastPanPos := TPointF.Create(X, Y); + + // Trigger repaint to apply the new transformation matrix + RecalcAbsolute; + RecalcUpdateRect; + Repaint; + end; +end; + +procedure TAuraWorkspace.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single); +begin + inherited; + // Stop panning + if (Button = TMouseButton.mbLeft) and (FIsPanning) then + begin + FIsPanning := False; + Cursor := crDefault; + end; +end; + +procedure TAuraWorkspace.MouseWheel(Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean); +var + oldZoom: Single; + MouseService: IFMXMouseService; +begin + inherited; + + if TPlatformServices.Current.SupportsPlatformService(IFMXMouseService, MouseService) then + begin + var MousePos := ScreenToLocal(MouseService.GetMousePos); + + oldZoom := FZoom; + + // Calculate new zoom + if WheelDelta > 0 then + FZoom := FZoom * 1.1 + else + FZoom := FZoom / 1.1; + + // Clamp zoom level to a reasonable range + FZoom := Max(0.2, Min(3.0, FZoom)); + + // Adjust panning to keep the point under the cursor stationary + FPanning.cx := MousePos.X * (1 - FZoom / oldZoom) + FPanning.cx * (FZoom / oldZoom); + FPanning.cy := MousePos.Y * (1 - FZoom / oldZoom) + FPanning.cy * (FZoom / oldZoom); + + // Trigger repaint to apply the new transformation matrix + RecalcAbsolute; + RecalcUpdateRect; + Repaint; + Handled := True; + end; +end; + procedure TAuraWorkspace.Paint; var connection: TPinConnection; diff --git a/Src/AST/Myc.Ast.Evaluator.pas b/Src/AST/Myc.Ast.Evaluator.pas index 6a2f533..678e0d3 100644 --- a/Src/AST/Myc.Ast.Evaluator.pas +++ b/Src/AST/Myc.Ast.Evaluator.pas @@ -122,61 +122,6 @@ type property Method: TNativeFunction read FMethod; end; -// --- Helper Functions --- - -function ScalarKindToString(AKind: TScalarKind): string; -begin - case AKind of - skInteger: Result := 'integer'; - skInt64: Result := 'int64'; - skUInt64: Result := 'uint64'; - skSingle: Result := 'single'; - skDouble: Result := 'double'; - skDateTime: Result := 'datetime'; - skTimestamp: Result := 'timestamp'; - skBoolean: Result := 'boolean'; - skChar: Result := 'char'; - skPChar: Result := 'pchar'; - skString: Result := 'string'; - skBytes: Result := 'bytes'; - skDecimal: Result := 'decimal'; - else - Result := 'unknown'; - end; -end; - -function StringToScalarKind(const AName: string): TScalarKind; -begin - if SameText(AName, 'integer') then - Result := skInteger - else if SameText(AName, 'int64') then - Result := skInt64 - else if SameText(AName, 'uint64') then - Result := skUInt64 - else if SameText(AName, 'single') then - Result := skSingle - else if SameText(AName, 'double') then - Result := skDouble - else if SameText(AName, 'datetime') then - Result := skDateTime - else if SameText(AName, 'timestamp') then - Result := skTimestamp - else if SameText(AName, 'boolean') then - Result := skBoolean - else if SameText(AName, 'char') then - Result := skChar - else if SameText(AName, 'pchar') then - Result := skPChar - else if SameText(AName, 'string') then - Result := skString - else if SameText(AName, 'bytes') then - Result := skBytes - else if SameText(AName, 'decimal') then - Result := skDecimal - else - raise EArgumentException.CreateFmt('Unknown scalar type name: "%s"', [AName]); -end; - // --- Native Functions Implementation --- function NativeCreateRecordSeries(const Args: TArray): TAstValue; @@ -201,13 +146,10 @@ end; // --- Registration Procedure --- procedure RegisterNativeFunctions(const AScope: IExecutionScope); -var - closure: TAstValue.IClosure; begin // Use 'Define' to clearly state that we are adding a new variable // to the global scope before the binder runs. - closure := TNativeClosure.Create(NativeCreateRecordSeries); - AScope.Define('CreateRecordSeries', TAstValue.FromClosure(closure)); + AScope.Define('CreateRecordSeries', TNativeClosure.Create(NativeCreateRecordSeries)); end; { TClosureValue } @@ -335,9 +277,8 @@ begin with seriesVar.AsSeries.Value do begin if (itemValue.AsScalar.Kind <> Kind) then - raise EArgumentException.CreateFmt( - 'Type mismatch: Cannot add %s to a series of %s.', - [ScalarKindToString(itemValue.AsScalar.Kind), ScalarKindToString(Kind)]); + raise EArgumentException + .CreateFmt('Type mismatch: Cannot add %s to a series of %s.', [itemValue.AsScalar.Kind.ToString, Kind.ToString]); Items.Add(itemValue.AsScalar.Value, lookback); end; @@ -365,7 +306,7 @@ end; function TEvaluatorVisitor.VisitConstant(const Node: IConstantNode): TAstValue; begin - Result := TAstValue.FromScalar(Node.Value); + Result := Node.Value; end; function TEvaluatorVisitor.VisitCreateSeries(const Node: ICreateSeriesNode): TAstValue; @@ -385,7 +326,7 @@ begin end else begin - var scalarKind := StringToScalarKind(def); + var scalarKind := TScalar.StringToKind(def); var scalarSeries := TScalarSeries.Create(scalarKind, Default(TSeries)); Result := TAstValue.FromSeries(scalarSeries); end; @@ -424,7 +365,7 @@ begin if (index < 0) or (index >= Items.TotalCount) then raise EArgumentException.CreateFmt('Index %d is out of bounds for series with %d elements.', [index, Items.TotalCount]); - Result := TAstValue.FromScalar(TScalar.Create(Kind, Items[Integer(index)])); + Result := TScalar.Create(Kind, Items[Integer(index)]); end; end; avkRecordSeries: @@ -443,8 +384,7 @@ begin raise EArgumentException .CreateFmt('Index %d is out of bounds for member series with %d elements.', [index, memberSeries.Count]); - var scalarValue := memberSeries.Items[Integer(index)]; - Result := TAstValue.FromScalar(scalarValue); + Result := memberSeries.Items[Integer(index)]; end; else raise EArgumentException.Create('Indexer `[]` is not supported for this value type.'); @@ -465,17 +405,17 @@ begin with baseValue.AsSeries.Value do begin if SameText(memberName, 'Count') then - Result := TAstValue.FromScalar(TScalar.FromInt64(Items.Count)) + Result := TScalar.FromInt64(Items.Count) else if SameText(memberName, 'TotalCount') then - Result := TAstValue.FromScalar(TScalar.FromInt64(Items.TotalCount)) + Result := TScalar.FromInt64(Items.TotalCount) else if SameText(memberName, 'Kind') then - Result := TAstValue.FromText(ScalarKindToString(Kind)) + Result := Kind.ToString else raise EArgumentException.CreateFmt('Member "%s" not found on TScalarSeries.', [memberName]); end; end; avkRecordSeries: Result := TAstValue.FromMemberSeries(baseValue.AsRecordSeries.Value.CreateMemberSeries(memberName)); - avkRecord: Result := TAstValue.FromScalar(baseValue.AsRecord.Items[memberName]); + avkRecord: Result := baseValue.AsRecord.Items[memberName]; else raise EArgumentException.Create('Member access operator `.` is not supported for this value type.'); end; @@ -507,16 +447,9 @@ begin sourceAddresses := Node.Upvalues; SetLength(capturedCells, Length(sourceAddresses)); for i := 0 to High(sourceAddresses) do - begin - sourceAddr := sourceAddresses[i]; - // The binder gives the depth relative to the lambda's - // inner scope. The evaluator is in the outer scope, so we adjust the - // depth by -1 to find the cell in the current context. - dec(sourceAddr.ScopeDepth); - capturedCells[i] := FScope.GetCell(sourceAddr); - end; + capturedCells[i] := FScope.GetCell(sourceAddresses[i]); - Result := TAstValue.FromClosure(TClosureValue.Create(Node, FScope, capturedCells)); + Result := TClosureValue.Create(Node, FScope, capturedCells); end; function TEvaluatorVisitor.VisitFunctionCall(const Node: IFunctionCallNode): TAstValue; @@ -610,16 +543,16 @@ begin var leftVal := leftScalar.Value.AsInt64; var rightVal := rightScalar.Value.AsInt64; case Node.Operator of - boAdd: Result := TAstValue.FromScalar(TScalar.FromInt64(leftVal + rightVal)); - boSubtract: Result := TAstValue.FromScalar(TScalar.FromInt64(leftVal - rightVal)); - boMultiply: Result := TAstValue.FromScalar(TScalar.FromInt64(leftVal * rightVal)); - boDivide: Result := TAstValue.FromScalar(TScalar.FromInt64(leftVal div rightVal)); - boEqual: Result := TAstValue.FromScalar(TScalar.FromBoolean(leftVal = rightVal)); - boNotEqual: Result := TAstValue.FromScalar(TScalar.FromBoolean(leftVal <> rightVal)); - boLess: Result := TAstValue.FromScalar(TScalar.FromBoolean(leftVal < rightVal)); - boGreater: Result := TAstValue.FromScalar(TScalar.FromBoolean(leftVal > rightVal)); - boLessOrEqual: Result := TAstValue.FromScalar(TScalar.FromBoolean(leftVal <= rightVal)); - boGreaterOrEqual: Result := TAstValue.FromScalar(TScalar.FromBoolean(leftVal >= rightVal)); + boAdd: Result := TScalar.FromInt64(leftVal + rightVal); + boSubtract: Result := TScalar.FromInt64(leftVal - rightVal); + boMultiply: Result := TScalar.FromInt64(leftVal * rightVal); + boDivide: Result := TScalar.FromInt64(leftVal div rightVal); + boEqual: Result := TScalar.FromBoolean(leftVal = rightVal); + boNotEqual: Result := TScalar.FromBoolean(leftVal <> rightVal); + boLess: Result := TScalar.FromBoolean(leftVal < rightVal); + boGreater: Result := TScalar.FromBoolean(leftVal > rightVal); + boLessOrEqual: Result := TScalar.FromBoolean(leftVal <= rightVal); + boGreaterOrEqual: Result := TScalar.FromBoolean(leftVal >= rightVal); else raise ENotSupportedException.Create('Operator not supported for Int64.'); end; @@ -629,16 +562,16 @@ begin var leftVal := leftScalar.Value.AsDouble; var rightVal := rightScalar.Value.AsDouble; case Node.Operator of - boAdd: Result := TAstValue.FromScalar(TScalar.FromDouble(leftVal + rightVal)); - boSubtract: Result := TAstValue.FromScalar(TScalar.FromDouble(leftVal - rightVal)); - boMultiply: Result := TAstValue.FromScalar(TScalar.FromDouble(leftVal * rightVal)); - boDivide: Result := TAstValue.FromScalar(TScalar.FromDouble(leftVal / rightVal)); - boEqual: Result := TAstValue.FromScalar(TScalar.FromBoolean(leftVal = rightVal)); - boNotEqual: Result := TAstValue.FromScalar(TScalar.FromBoolean(leftVal <> rightVal)); - boLess: Result := TAstValue.FromScalar(TScalar.FromBoolean(leftVal < rightVal)); - boGreater: Result := TAstValue.FromScalar(TScalar.FromBoolean(leftVal > rightVal)); - boLessOrEqual: Result := TAstValue.FromScalar(TScalar.FromBoolean(leftVal <= rightVal)); - boGreaterOrEqual: Result := TAstValue.FromScalar(TScalar.FromBoolean(leftVal >= rightVal)); + boAdd: Result := TScalar.FromDouble(leftVal + rightVal); + boSubtract: Result := TScalar.FromDouble(leftVal - rightVal); + boMultiply: Result := TScalar.FromDouble(leftVal * rightVal); + boDivide: Result := TScalar.FromDouble(leftVal / rightVal); + boEqual: Result := TScalar.FromBoolean(leftVal = rightVal); + boNotEqual: Result := TScalar.FromBoolean(leftVal <> rightVal); + boLess: Result := TScalar.FromBoolean(leftVal < rightVal); + boGreater: Result := TScalar.FromBoolean(leftVal > rightVal); + boLessOrEqual: Result := TScalar.FromBoolean(leftVal <= rightVal); + boGreaterOrEqual: Result := TScalar.FromBoolean(leftVal >= rightVal); else raise ENotSupportedException.Create('Operator not supported for Double.'); end; @@ -662,15 +595,15 @@ begin raise ENotSupportedException.Create('Unary "-" is only supported for scalar types.'); rightScalar := rightValue.AsScalar; case rightScalar.Kind of - skInt64: Result := TAstValue.FromScalar(TScalar.FromInt64(-rightScalar.Value.AsInt64)); - skDouble: Result := TAstValue.FromScalar(TScalar.FromDouble(-rightScalar.Value.AsDouble)); + skInt64: Result := TScalar.FromInt64(-rightScalar.Value.AsInt64); + skDouble: Result := TScalar.FromDouble(-rightScalar.Value.AsDouble); else raise ENotSupportedException.Create('Unary "-" is not supported for this scalar type.'); end; end; uoNot: begin - Result := TAstValue.FromScalar(TScalar.FromBoolean(not IsTruthy(rightValue))); + Result := TScalar.FromBoolean(not IsTruthy(rightValue)); end; else raise ENotSupportedException.Create('Unary operator not supported'); @@ -731,7 +664,7 @@ begin raise EArgumentException.CreateFmt('Cannot get length of type %s.', [GetEnumName(TypeInfo(TAstValueKind), Ord(seriesValue.Kind))]); end; - Result := TAstValue.FromScalar(TScalar.FromInt64(len)); + Result := TScalar.FromInt64(len); end; { TDebugEvaluatorVisitor } diff --git a/Src/AST/Myc.Ast.Nodes.pas b/Src/AST/Myc.Ast.Nodes.pas index 49b1f5c..ba5dd21 100644 --- a/Src/AST/Myc.Ast.Nodes.pas +++ b/Src/AST/Myc.Ast.Nodes.pas @@ -80,9 +80,9 @@ type public class operator Initialize(out Dest: TAstValue); class function Void: TAstValue; inline; static; - class function FromScalar(const AValue: TScalar): TAstValue; inline; static; - class function FromClosure(const AValue: TAstValue.IClosure): TAstValue; inline; static; - class function FromText(const AValue: String): TAstValue; inline; static; + class operator Implicit(const AValue: TScalar): TAstValue; overload; inline; + class operator Implicit(const AValue: TAstValue.IClosure): TAstValue; overload; inline; + class operator Implicit(const AValue: String): TAstValue; overload; inline; class function FromSeries(const [ref] AValue: TScalarSeries): TAstValue; static; inline; class function FromRecordSeries(const [ref] AValue: TScalarRecordSeries): TAstValue; static; inline; class function FromRecord(const [ref] AValue: TScalarRecord): TAstValue; static; inline; @@ -116,8 +116,7 @@ type Kind: TAddressKind; ScopeDepth: Integer; SlotIndex: Integer; - Name: String; - constructor Create(AKind: TAddressKind; AScopeDepth, ASlotIndex: Integer; const AName: String); + constructor Create(AKind: TAddressKind; AScopeDepth, ASlotIndex: Integer); class operator Initialize(out Dest: TResolvedAddress); end; @@ -402,7 +401,7 @@ begin Result := (FInterface as TVal).Value; end; -class function TAstValue.FromClosure(const AValue: TAstValue.IClosure): TAstValue; +class operator TAstValue.Implicit(const AValue: TAstValue.IClosure): TAstValue; begin Result.FKind := avkClosure; Result.FInterface := AValue; @@ -430,7 +429,7 @@ begin Result.FScalar := Default(TScalar); end; -class function TAstValue.FromScalar(const AValue: TScalar): TAstValue; +class operator TAstValue.Implicit(const AValue: TScalar): TAstValue; begin Result.FKind := avkScalar; Result.FScalar := AValue; @@ -444,7 +443,7 @@ begin Result.FScalar := Default(TScalar); end; -class function TAstValue.FromText(const AValue: String): TAstValue; +class operator TAstValue.Implicit(const AValue: String): TAstValue; begin Result.FKind := avkText; Result.FInterface := TVal.Create(AValue); @@ -484,12 +483,11 @@ end; { TResolvedAddress } -constructor TResolvedAddress.Create(AKind: TAddressKind; AScopeDepth, ASlotIndex: Integer; const AName: String); +constructor TResolvedAddress.Create(AKind: TAddressKind; AScopeDepth, ASlotIndex: Integer); begin Kind := AKind; ScopeDepth := AScopeDepth; SlotIndex := ASlotIndex; - Name := AName; end; class operator TResolvedAddress.Initialize(out Dest: TResolvedAddress); @@ -497,7 +495,6 @@ begin Dest.Kind := akUnresolved; Dest.ScopeDepth := -1; Dest.SlotIndex := -1; - Dest.Name := 'unresolved'; end; { TBinaryOperatorHelper } diff --git a/Src/AST/Myc.Ast.Printer.pas b/Src/AST/Myc.Ast.Printer.pas index 9d52a3e..db98c5f 100644 --- a/Src/AST/Myc.Ast.Printer.pas +++ b/Src/AST/Myc.Ast.Printer.pas @@ -299,7 +299,7 @@ var begin // Get the string representation of the series identifier by visiting the node. seriesStr := Node.Series.Accept(Self).ToString; - Result := TAstValue.FromText(Format('length(%s)', [seriesStr])); + Result := Format('length(%s)', [seriesStr]); end; end. diff --git a/Src/AST/Myc.Ast.pas b/Src/AST/Myc.Ast.pas index 7d0fbe9..91558e9 100644 --- a/Src/AST/Myc.Ast.pas +++ b/Src/AST/Myc.Ast.pas @@ -86,7 +86,7 @@ type constructor Create(AParent: IScopeDescriptor); destructor Destroy; override; function Define(const Name: string): Integer; - function FindSymbol(const Name: string; out Index: Integer; out Depth: Integer): Boolean; + function FindSymbol(const Name: string; out Depth, Index: Integer): Boolean; function CreateScope(const AParent: IExecutionScope): IExecutionScope; procedure PopulateFromScope(const AScope: IExecutionScope); property Symbols: TDictionary read FSymbols; @@ -365,7 +365,7 @@ begin FSymbols.Add(Name, Result); end; -function TScopeDescriptor.FindSymbol(const Name: string; out Index: Integer; out Depth: Integer): Boolean; +function TScopeDescriptor.FindSymbol(const Name: string; out Depth, Index: Integer): Boolean; var currentDescriptor: IScopeDescriptor; begin @@ -579,7 +579,6 @@ begin FBody := ABody; FParameters := AParameters; FScopeDescriptor := nil; - FUpvalues := []; // Initialize new field end; function TLambdaExpressionNode.GetUpvalues: TArray; @@ -866,7 +865,7 @@ end; function TBinder.VisitIdentifier(const Node: IIdentifierNode): TAstValue; var - originalDepth, originalIndex: Integer; + depth, idx: Integer; identNode: TIdentifierNode; upvalueMap: TDictionary; upvalueNodes: TList; @@ -877,14 +876,17 @@ begin if identNode.IsResolved then Exit; - if (FCurrentDescriptor as TScopeDescriptor).FindSymbol(identNode.Name, originalIndex, originalDepth) then + if (FCurrentDescriptor as TScopeDescriptor).FindSymbol(identNode.Name, depth, idx) then begin - if (originalDepth > 0) and (FUpvalueMapStack.Count > 0) then + if (depth > 0) and (FUpvalueMapStack.Count > 0) then begin upvalueMap := FUpvalueMapStack.Peek; upvalueNodes := FUpvalueNodesStack.Peek; - originalAddress.Create(akLocalOrParent, originalDepth, originalIndex, identNode.Name); + // Imortant: we are now in the lambda's inner scope, so decrease depth by one to point to the outer scope. + dec(depth); + + originalAddress.Create(akLocalOrParent, depth, idx); if not upvalueMap.TryGetValue(originalAddress, upvalueIndex) then begin @@ -893,12 +895,10 @@ begin upvalueNodes.Add(identNode); end; - identNode.FResolvedAddress.Create(akUpvalue, 0, upvalueIndex, identNode.Name); + identNode.FResolvedAddress.Create(akUpvalue, 0, upvalueIndex); end else - begin - identNode.FResolvedAddress.Create(akLocalOrParent, originalDepth, originalIndex, identNode.Name); - end; + identNode.FResolvedAddress.Create(akLocalOrParent, depth, idx); end else raise Exception.CreateFmt('Undefined identifier: "%s"', [identNode.Name]); @@ -963,7 +963,7 @@ begin Node.Initializer.Accept(Self); slotIndex := (FCurrentDescriptor as TScopeDescriptor).Define(Node.Identifier.Name); - identNode.FResolvedAddress.Create(akLocalOrParent, 0, slotIndex, Node.Identifier.Name); + identNode.FResolvedAddress.Create(akLocalOrParent, 0, slotIndex); end; { TAst } diff --git a/Src/Data/Myc.Data.Scalar.pas b/Src/Data/Myc.Data.Scalar.pas index e5b6dcb..3cfcc85 100644 --- a/Src/Data/Myc.Data.Scalar.pas +++ b/Src/Data/Myc.Data.Scalar.pas @@ -90,9 +90,16 @@ type class function FromBytes(const AValue: TScalarBytes): TScalar; static; inline; class function FromDecimal(const AValue: TDecimal): TScalar; static; inline; + class function StringToKind(const AName: string): TScalarKind; static; + function ToString: String; end; + TScalarKindHelper = record helper for TScalarKind + public + function ToString: string; + end; + // Basic data structures using the scalar type (these are not POD of course) // An array of scalar values of the same kind. @@ -383,6 +390,38 @@ begin Result.Value := TScalarValue.FromUInt64(AValue); end; +class function TScalar.StringToKind(const AName: string): TScalarKind; +begin + if SameText(AName, 'integer') then + Result := skInteger + else if SameText(AName, 'int64') then + Result := skInt64 + else if SameText(AName, 'uint64') then + Result := skUInt64 + else if SameText(AName, 'single') then + Result := skSingle + else if SameText(AName, 'double') then + Result := skDouble + else if SameText(AName, 'datetime') then + Result := skDateTime + else if SameText(AName, 'timestamp') then + Result := skTimestamp + else if SameText(AName, 'boolean') then + Result := skBoolean + else if SameText(AName, 'char') then + Result := skChar + else if SameText(AName, 'pchar') then + Result := skPChar + else if SameText(AName, 'string') then + Result := skString + else if SameText(AName, 'bytes') then + Result := skBytes + else if SameText(AName, 'decimal') then + Result := skDecimal + else + raise EArgumentException.CreateFmt('Unknown scalar type name: "%s"', [AName]); +end; + function TScalar.ToString: String; begin case Kind of @@ -645,6 +684,27 @@ begin Result.Create(FDef, values); end; +function TScalarKindHelper.ToString: string; +begin + case Self of + skInteger: Result := 'integer'; + skInt64: Result := 'int64'; + skUInt64: Result := 'uint64'; + skSingle: Result := 'single'; + skDouble: Result := 'double'; + skDateTime: Result := 'datetime'; + skTimestamp: Result := 'timestamp'; + skBoolean: Result := 'boolean'; + skChar: Result := 'char'; + skPChar: Result := 'pchar'; + skString: Result := 'string'; + skBytes: Result := 'bytes'; + skDecimal: Result := 'decimal'; + else + Result := 'unknown'; + end; +end; + initialization Assert(sizeof(TScalarValue) = 8);