Macros refactoring
This commit is contained in:
+41
-19
@@ -146,6 +146,7 @@ implementation
|
||||
uses
|
||||
Myc.Data.Scalar.JSON,
|
||||
System.Diagnostics, // For TStopwatch
|
||||
System.TimeSpan,
|
||||
Myc.Ast.Json, // For TAstJson serialization
|
||||
Myc.Ast.Types, // Needed for TTypeRules
|
||||
System.IOUtils; // For TFile
|
||||
@@ -332,26 +333,47 @@ begin
|
||||
|
||||
Scope.Define(
|
||||
'print',
|
||||
TDataValue(
|
||||
function(const Args: TArray<TDataValue>): TDataValue
|
||||
var
|
||||
str: TStringBuilder;
|
||||
begin
|
||||
str := TStringBuilder.Create;
|
||||
try
|
||||
for var i := 0 to High(Args) do
|
||||
begin
|
||||
if Args[i].Kind = vkText then
|
||||
str.Append(Args[i].AsText)
|
||||
else
|
||||
str.Append(Args[i].ToString);
|
||||
end;
|
||||
Memo1.Lines.Add(str.ToString);
|
||||
finally
|
||||
str.Free;
|
||||
function(const Args: TArray<TDataValue>): TDataValue
|
||||
var
|
||||
str: TStringBuilder;
|
||||
begin
|
||||
str := TStringBuilder.Create;
|
||||
try
|
||||
for var i := 0 to High(Args) do
|
||||
begin
|
||||
if Args[i].Kind = vkText then
|
||||
str.Append(Args[i].AsText)
|
||||
else
|
||||
str.Append(Args[i].ToString);
|
||||
end;
|
||||
end
|
||||
)
|
||||
Memo1.Lines.Add(str.ToString);
|
||||
finally
|
||||
str.Free;
|
||||
end;
|
||||
end
|
||||
);
|
||||
|
||||
Scope.Define(
|
||||
'timestamp',
|
||||
function(const Args: TArray<TDataValue>): TDataValue
|
||||
begin
|
||||
Result := TStopwatch.GetTimeStamp div TTimeSpan.TicksPerMillisecond;
|
||||
end
|
||||
);
|
||||
|
||||
TMacroExpander.GlobalMacroRegistry.Define(
|
||||
TAstScript
|
||||
.Parse(
|
||||
'''
|
||||
(defmacro stopwatch [body]
|
||||
`(do
|
||||
(def start-time (timestamp))
|
||||
(def result ~body)
|
||||
(print "Stopwatch: " (- (timestamp) start-time) "ms" )
|
||||
result
|
||||
))
|
||||
''')
|
||||
.AsMacroDefinition
|
||||
);
|
||||
end
|
||||
);
|
||||
|
||||
@@ -54,14 +54,19 @@ type
|
||||
public
|
||||
constructor Create(AParent: TMacroRegistry);
|
||||
destructor Destroy; override;
|
||||
procedure Define(const Name: string; const Node: IMacroDefinitionNode);
|
||||
procedure Define(const Node: IMacroDefinitionNode);
|
||||
function Find(const Name: string): IMacroDefinitionNode;
|
||||
end;
|
||||
|
||||
strict private
|
||||
class var
|
||||
FGlobalMacroRegistry: TMacroRegistry;
|
||||
class constructor CreateClass;
|
||||
class destructor DestroyClass;
|
||||
|
||||
private
|
||||
FInitialScope: IExecutionScope;
|
||||
|
||||
// Ersetzt FCurrentDescriptor
|
||||
FCurrentMacroRegistry: TMacroRegistry;
|
||||
|
||||
FEvaluatorFactory: TEvaluatorFactory;
|
||||
@@ -78,7 +83,6 @@ type
|
||||
function VisitUnquote(const Node: IUnquoteNode): IAstNode; override;
|
||||
function VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): IAstNode; override;
|
||||
|
||||
// NEU: Überschrieben für lexikalisches Makro-Scoping
|
||||
function VisitBlockExpression(const Node: IBlockExpressionNode): IAstNode; override;
|
||||
function VisitLambdaExpression(const Node: ILambdaExpressionNode): IAstNode; override;
|
||||
|
||||
@@ -86,7 +90,6 @@ type
|
||||
constructor Create(const AInitialScope: IExecutionScope; const AEvaluatorFactory: TEvaluatorFactory);
|
||||
destructor Destroy; override;
|
||||
|
||||
// Signatur geändert
|
||||
function Execute(const RootNode: IAstNode): IAstNode;
|
||||
|
||||
class function ExpandMacros(
|
||||
@@ -94,6 +97,8 @@ type
|
||||
const RootNode: IAstNode;
|
||||
const EvaluatorFactory: TEvaluatorFactory
|
||||
): IAstNode; static;
|
||||
|
||||
class property GlobalMacroRegistry: TMacroRegistry read FGlobalMacroRegistry;
|
||||
end;
|
||||
|
||||
implementation
|
||||
@@ -119,9 +124,9 @@ begin
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TMacroExpander.TMacroRegistry.Define(const Name: string; const Node: IMacroDefinitionNode);
|
||||
procedure TMacroExpander.TMacroRegistry.Define(const Node: IMacroDefinitionNode);
|
||||
begin
|
||||
FMacros.AddOrSetValue(Name, Node);
|
||||
FMacros.AddOrSetValue(Node.Name.Name, Node);
|
||||
end;
|
||||
|
||||
function TMacroExpander.TMacroRegistry.Find(const Name: string): IMacroDefinitionNode;
|
||||
@@ -292,7 +297,12 @@ begin
|
||||
FEvaluatorFactory := AEvaluatorFactory;
|
||||
|
||||
// Erzeugt die Root-Registry für Makros
|
||||
FCurrentMacroRegistry := TMacroRegistry.Create(nil);
|
||||
FCurrentMacroRegistry := TMacroRegistry.Create(FGlobalMacroRegistry);
|
||||
end;
|
||||
|
||||
class constructor TMacroExpander.CreateClass;
|
||||
begin
|
||||
FGlobalMacroRegistry := TMacroRegistry.Create(nil);
|
||||
end;
|
||||
|
||||
destructor TMacroExpander.Destroy;
|
||||
@@ -301,6 +311,11 @@ begin
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
class destructor TMacroExpander.DestroyClass;
|
||||
begin
|
||||
FGlobalMacroRegistry.Free;
|
||||
end;
|
||||
|
||||
procedure TMacroExpander.EnterMacroScope;
|
||||
begin
|
||||
// Erstellt eine neue Registry mit der aktuellen als Parent
|
||||
@@ -334,13 +349,10 @@ begin
|
||||
|
||||
if not Assigned(Result) then
|
||||
Result := TAst.Block([]); // e.g. if root was (defmacro ...)
|
||||
|
||||
// Descriptor := FCurrentDescriptor; // Entfernt
|
||||
end;
|
||||
|
||||
function TMacroExpander.VisitBlockExpression(const Node: IBlockExpressionNode): IAstNode;
|
||||
begin
|
||||
// Ein 'do'-Block eröffnet einen neuen Scope für Makros
|
||||
EnterMacroScope;
|
||||
try
|
||||
Result := inherited VisitBlockExpression(Node);
|
||||
@@ -351,7 +363,6 @@ end;
|
||||
|
||||
function TMacroExpander.VisitLambdaExpression(const Node: ILambdaExpressionNode): IAstNode;
|
||||
begin
|
||||
// Eine 'fn' eröffnet einen neuen Scope für Makros
|
||||
EnterMacroScope;
|
||||
try
|
||||
Result := inherited VisitLambdaExpression(Node);
|
||||
@@ -363,7 +374,7 @@ end;
|
||||
function TMacroExpander.VisitMacroDefinition(const Node: IMacroDefinitionNode): IAstNode;
|
||||
begin
|
||||
// Register the macro in the *current* macro registry
|
||||
FCurrentMacroRegistry.Define(Node.Name.Name, Node);
|
||||
FCurrentMacroRegistry.Define(Node);
|
||||
|
||||
// Keep the node in the AST (for the visualizer).
|
||||
Result := Node;
|
||||
|
||||
@@ -13,7 +13,7 @@ type
|
||||
TRtlFunctions = record
|
||||
public
|
||||
[TRtlFunction('+')]
|
||||
class function Add(const Args: TArray<TDataValue>): TDataValue; static;
|
||||
class function Add(const Args: TArray<TDataValue>): TDataValue; overload; static;
|
||||
|
||||
[TRtlFunction('-')]
|
||||
class function Subtract(const Args: TArray<TDataValue>): TDataValue; static;
|
||||
|
||||
Reference in New Issue
Block a user