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

Refactoring + Panning in Workspace

Browse Source
This commit is contained in:
Michael Schimmel
2025-09-05 21:00:07 +02:00
parent f2357a543e
commit 6b77391e91
6 changed files with 253 additions and 145 deletions
Download Patch File Download Diff File Expand all files Collapse all files
ASTPlayground/Myc.Ast.Visualizer.pas
+135 -17
View File
@@ -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<TPinConnection>;
// 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<TPinConnection>.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;
Src/AST/Myc.Ast.Evaluator.pas
+37 -104
View File
@@ -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>): 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<TScalarValue>));
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 }
Src/AST/Myc.Ast.Nodes.pas
+8 -11
View File
@@ -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<String>).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<String>.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 }
Src/AST/Myc.Ast.Printer.pas
+1 -1
View File
@@ -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.
Src/AST/Myc.Ast.pas
+12 -12
View File
@@ -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<string, Integer> 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<TResolvedAddress>;
@@ -866,7 +865,7 @@ end;
function TBinder.VisitIdentifier(const Node: IIdentifierNode): TAstValue;
var
originalDepth, originalIndex: Integer;
depth, idx: Integer;
identNode: TIdentifierNode;
upvalueMap: TDictionary<TResolvedAddress, Integer>;
upvalueNodes: TList<IIdentifierNode>;
@@ -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 }
Src/Data/Myc.Data.Scalar.pas
+60
View File
@@ -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);