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

Resolved cyclic dependencies between environment and compiler stages

Browse Source
This commit is contained in:
Michael Schimmel
2025-11-23 17:55:47 +01:00
parent 7c761e86e5
commit d334ffdc73
5 changed files with 211 additions and 201 deletions
Download Patch File Download Diff File Expand all files Collapse all files
ASTPlayground/MainForm.pas
+1
View File
@@ -39,6 +39,7 @@ uses
FMX.ListView.Appearances,
FMX.ListView.Adapters.Base,
FMX.ListView,
Myc.Ast.Compiler.Specializer,
Myc.Ast.Environment,
FMX.ListBox; // Added Environment
Src/AST/Myc.Ast.Compiler.Binder.pas
+6 -2
View File
@@ -13,14 +13,18 @@ uses
Myc.Ast.Scope,
Myc.Ast.Types,
Myc.Ast.Compiler.Binder.Upvalues,
Myc.Ast,
Myc.Ast.Environment;
Myc.Ast;
type
IAstBinder = interface(IAstVisitor)
function Execute(const RootNode: IAstNode; out Layout: IScopeLayout): IAstNode;
end;
IFunctionDefinitionRegistry = interface
procedure Register(const Address: TResolvedAddress; const ADef: IFunctionDefinition);
function Resolve(const Address: TResolvedAddress): IFunctionDefinition;
end;
TAstBinder = class(TAstTransformer, IAstBinder)
private
type
Src/AST/Myc.Ast.Compiler.Macros.pas
+11 -2
View File
@@ -12,8 +12,7 @@ uses
Myc.Ast.Visitor,
Myc.Ast.Scope,
Myc.Ast.Types,
Myc.Ast,
Myc.Ast.Environment;
Myc.Ast;
type
IAstMacroExpander = interface(IAstVisitor)
@@ -56,6 +55,16 @@ type
): IAstNode;
end;
IMacroRegistry = interface
{$region 'private'}
function GetParent: IMacroRegistry;
{$endregion}
procedure Define(const Node: IMacroDefinitionNode);
function Find(const Name: string): IMacroDefinitionNode;
function CreateChildRegistry: IMacroRegistry;
property Parent: IMacroRegistry read GetParent;
end;
// Handles the expansion of macro calls within the AST.
TMacroExpander = class(TAstTransformer, IAstMacroExpander)
private
Src/AST/Myc.Ast.Compiler.Specializer.pas
+82 -15
View File
@@ -5,27 +5,55 @@ interface
uses
System.SysUtils,
System.Generics.Collections,
System.Generics.Defaults,
Myc.Data.Value,
Myc.Ast,
Myc.Ast.Types,
Myc.Ast.Nodes,
Myc.Ast.Visitor,
Myc.Ast.Scope,
Myc.Ast.Environment,
Myc.Ast.RTL;
Myc.Ast.RTL,
Myc.Ast.Compiler.Binder;
type
IAstSpecializer = interface(IAstVisitor)
function Execute(const RootNode: IAstNode): IAstNode;
end;
// --- Monomorphization Cache Definitions ---
TMonoCacheKey = record
public
Address: TResolvedAddress;
ArgTypes: TArray<IStaticType>;
Func: TDataValue.TFunc;
constructor Create(const AAddress: TResolvedAddress; const AArgTypes: TArray<IStaticType>);
end;
IMonomorphCache = interface
function TryGetFunction(const Key: TMonoCacheKey; out Func: TSpecializedMethod): Boolean;
procedure Add(const Key: TMonoCacheKey; const Func: TSpecializedMethod);
end;
TCompiledFunction = record
public
Func: TDataValue.TFunc;
StaticType: IStaticType;
IsPure: Boolean;
constructor Create(const AFunc: TDataValue.TFunc; const AStaticType: IStaticType; AIsPure: Boolean);
end;
// This transformer runs *after* TypeChecker.
// It specializes all statically resolvable function calls (RTL and user-defined)
// by replacing them with nodes that have a direct StaticTarget.
// It propagates Purity information but does NOT perform Constant Folding yet.
TStaticSpecializer = class(TAstTransformer, IAstSpecializer)
type
TCompileFunc = reference to function(const Node: IFunctionDefinition; const ArgTypes: TArray<IStaticType>): TCompiledFunction;
private
FEnvironment: IEnvironment;
FMonomorphCache: IMonomorphCache;
FFunctionRegistry: IFunctionDefinitionRegistry;
FCompileFunc: TCompileFunc;
function GetStaticRtlFunction(const AName: string; const AArgTypes: TArray<IStaticType>): TSpecializedMethod;
@@ -33,26 +61,48 @@ type
function VisitFunctionCall(const Node: IFunctionCallNode): IAstNode; override;
public
constructor Create(const AEnvironment: IEnvironment);
constructor Create(
const AMonomorphCache: IMonomorphCache;
const AFunctionRegistry: IFunctionDefinitionRegistry;
const ACompileFunc: TCompileFunc
);
function Execute(const RootNode: IAstNode): IAstNode;
class function Specialize(const AEnvironment: IEnvironment; const RootNode: IAstNode): IAstNode; static;
class function Specialize(
const RootNode: IAstNode;
const AMonomorphCache: IMonomorphCache;
const AFunctionRegistry: IFunctionDefinitionRegistry;
const ACompileFunc: TCompileFunc
): IAstNode; static;
end;
implementation
uses
System.Hash;
{ TStaticSpecializer }
constructor TStaticSpecializer.Create(const AEnvironment: IEnvironment);
constructor TStaticSpecializer.Create(
const AMonomorphCache: IMonomorphCache;
const AFunctionRegistry: IFunctionDefinitionRegistry;
const ACompileFunc: TCompileFunc
);
begin
inherited Create;
Assert(Assigned(AEnvironment));
FEnvironment := AEnvironment;
FMonomorphCache := AMonomorphCache;
FFunctionRegistry := AFunctionRegistry;
FCompileFunc := ACompileFunc;
end;
class function TStaticSpecializer.Specialize(const AEnvironment: IEnvironment; const RootNode: IAstNode): IAstNode;
class function TStaticSpecializer.Specialize(
const RootNode: IAstNode;
const AMonomorphCache: IMonomorphCache;
const AFunctionRegistry: IFunctionDefinitionRegistry;
const ACompileFunc: TCompileFunc
): IAstNode;
begin
var specializer := TStaticSpecializer.Create(AEnvironment) as IAstSpecializer;
var specializer := TStaticSpecializer.Create(AMonomorphCache, AFunctionRegistry, ACompileFunc) as IAstSpecializer;
Result := specializer.Execute(RootNode);
end;
@@ -125,7 +175,7 @@ begin
// 4. Check the Environment (Instance) Cache
key := TMonoCacheKey.Create(calleeIdent.Address, argTypes);
if FEnvironment.MonomorphCache.TryGetValue(key, specializedMethod) then
if FMonomorphCache.TryGetFunction(key, specializedMethod) then
begin
// 4a. Cache Hit (Environment)
// Propagate IsPure flag from cache to AST node
@@ -146,7 +196,7 @@ begin
if Assigned(specializedMethod.Target) then
begin
// 5a. Cache Hit (RTL)
FEnvironment.MonomorphCache.Add(key, specializedMethod);
FMonomorphCache.Add(key, specializedMethod);
// Propagate IsPure flag from RTL definition to AST node
Result :=
@@ -162,7 +212,7 @@ begin
end;
// 6. Cache Miss (User Code)
funcDef := FEnvironment.FunctionRegistry.Resolve(calleeIdent.Address);
funcDef := FFunctionRegistry.Resolve(calleeIdent.Address);
if (funcDef <> nil) then
begin
@@ -179,13 +229,13 @@ begin
// 6a. Compile func with KNOWN TYPES
// This recursively triggers Bind -> Check -> Specialize -> Purity Inference for the callee body!
var compiled := FEnvironment.Compile(funcDef, argTypes);
var compiled := FCompileFunc(funcDef, argTypes);
// 6b. Store in cache
// Get the return type from the *full function type* returned by Compile
var returnType := compiled.StaticType.Signatures[0].ReturnType;
specializedMethod := TSpecializedMethod.Create(compiled.Func, returnType, compiled.IsPure);
FEnvironment.MonomorphCache.Add(key, specializedMethod);
FMonomorphCache.Add(key, specializedMethod);
// 6c. Return the new node
// Propagate the inferred IsPure flag to the AST node
@@ -200,4 +250,21 @@ begin
Result := TAst.FunctionCall(newCallee, newArgs, Node.StaticType, Node.IsTailCall, nil);
end;
{ TMonoCacheKey }
constructor TMonoCacheKey.Create(const AAddress: TResolvedAddress; const AArgTypes: TArray<IStaticType>);
begin
Address := AAddress;
ArgTypes := AArgTypes;
end;
{ TCompiledFunction }
constructor TCompiledFunction.Create(const AFunc: TDataValue.TFunc; const AStaticType: IStaticType; AIsPure: Boolean);
begin
Func := AFunc;
StaticType := AStaticType;
IsPure := AIsPure;
end;
end.
Src/AST/Myc.Ast.Environment.pas
+111 -182
View File
@@ -12,63 +12,27 @@ uses
Myc.Ast.Nodes,
Myc.Ast.Scope,
Myc.Ast.RTL,
Myc.Ast.Types;
Myc.Ast.Types,
Myc.Ast.Compiler.Macros,
Myc.Ast.Compiler.Binder,
Myc.Ast.Compiler.TypeChecker,
Myc.Ast.Compiler.Specializer,
Myc.Ast.Compiler.TCO,
Myc.Ast.Analysis.Purity;
type
IMacroRegistry = interface;
IEnvironment = interface;
IExecutionStrategy = interface;
IFunctionDefinitionRegistry = interface;
// --- Monomorphization Cache Definitions ---
TMonoCacheKey = record
public
Address: TResolvedAddress;
ArgTypes: TArray<IStaticType>;
constructor Create(const AAddress: TResolvedAddress; const AArgTypes: TArray<IStaticType>);
end;
TMonoCacheKeyComparer = class(TEqualityComparer<TMonoCacheKey>)
public
function Equals(const Left, Right: TMonoCacheKey): Boolean; override;
function GetHashCode(const Value: TMonoCacheKey): Integer; override;
end;
TMonomorphCache = TDictionary<TMonoCacheKey, TSpecializedMethod>;
TCompiledFunction = record
public
Func: TDataValue.TFunc;
StaticType: IStaticType;
IsPure: Boolean;
constructor Create(const AFunc: TDataValue.TFunc; const AStaticType: IStaticType; AIsPure: Boolean);
end;
IExecutionStrategy = interface
function CreateVisitor(const AScope: IExecutionScope): IEvaluatorVisitor;
end;
IMacroRegistry = interface
{$region 'private'}
function GetParent: IMacroRegistry;
{$endregion}
procedure Define(const Node: IMacroDefinitionNode);
function Find(const Name: string): IMacroDefinitionNode;
function CreateChildRegistry: IMacroRegistry;
property Parent: IMacroRegistry read GetParent;
end;
IFunctionDefinitionRegistry = interface
procedure Register(const Address: TResolvedAddress; const ADef: IFunctionDefinition);
function Resolve(const Address: TResolvedAddress): IFunctionDefinition;
end;
IEnvironment = interface
{$region 'private'}
function GetRootScope: IExecutionScope;
function GetMacroRegistry: IMacroRegistry;
function GetMonomorphCache: TMonomorphCache;
function GetMonomorphCache: IMonomorphCache;
function GetFunctionRegistry: IFunctionDefinitionRegistry;
{$endregion}
@@ -94,7 +58,7 @@ type
property RootScope: IExecutionScope read GetRootScope;
property MacroRegistry: IMacroRegistry read GetMacroRegistry;
property MonomorphCache: TMonomorphCache read GetMonomorphCache;
property MonomorphCache: IMonomorphCache read GetMonomorphCache;
property FunctionRegistry: IFunctionDefinitionRegistry read GetFunctionRegistry;
end;
@@ -139,79 +103,25 @@ implementation
uses
System.Hash,
Myc.Ast.Evaluator,
Myc.Ast.Debugger,
Myc.Ast.Compiler.Macros,
Myc.Ast.Compiler.Binder,
Myc.Ast.Compiler.TypeChecker,
Myc.Ast.Compiler.Specializer,
Myc.Ast.Compiler.TCO,
Myc.Ast.Analysis.Purity;
{ TMonoCacheKey }
constructor TMonoCacheKey.Create(const AAddress: TResolvedAddress; const AArgTypes: TArray<IStaticType>);
begin
Address := AAddress;
ArgTypes := AArgTypes;
end;
{ TMonoCacheKeyComparer }
function TMonoCacheKeyComparer.Equals(const Left, Right: TMonoCacheKey): Boolean;
var
i: Integer;
begin
if not (Left.Address = Right.Address) then
exit(False);
if Length(Left.ArgTypes) <> Length(Right.ArgTypes) then
exit(False);
for i := 0 to High(Left.ArgTypes) do
begin
if not Left.ArgTypes[i].IsEqual(Right.ArgTypes[i]) then
exit(False);
end;
Result := True;
end;
function TMonoCacheKeyComparer.GetHashCode(const Value: TMonoCacheKey): Integer;
var
i: Integer;
hash: Integer;
typeHash: Integer;
adr: TResolvedAddress;
begin
adr := Value.Address;
hash := THashBobJenkins.GetHashValue(adr.Kind, SizeOf(TAddressKind), 0);
hash := THashBobJenkins.GetHashValue(adr.ScopeDepth, SizeOf(Integer), hash);
hash := THashBobJenkins.GetHashValue(adr.SlotIndex, SizeOf(Integer), hash);
for i := 0 to High(Value.ArgTypes) do
begin
if Assigned(Value.ArgTypes[i]) then
typeHash := Value.ArgTypes[i].GetHashCode
else
typeHash := 0;
hash := THashBobJenkins.GetHashValue(typeHash, SizeOf(Integer), hash);
end;
Result := hash;
end;
{ TCompiledFunction }
constructor TCompiledFunction.Create(const AFunc: TDataValue.TFunc; const AStaticType: IStaticType; AIsPure: Boolean);
begin
Func := AFunc;
StaticType := AStaticType;
IsPure := AIsPure;
end;
Myc.Ast.Debugger;
type
TMonoCacheKeyComparer = class(TEqualityComparer<TMonoCacheKey>)
public
function Equals(const Left, Right: TMonoCacheKey): Boolean; override;
function GetHashCode(const Value: TMonoCacheKey): Integer; override;
end;
TMonomorphCache = class(TInterfacedObject, IMonomorphCache)
private
FMonomorphCache: TDictionary<TMonoCacheKey, TSpecializedMethod>;
public
constructor Create;
destructor Destroy; override;
function TryGetFunction(const Key: TMonoCacheKey; out Func: TSpecializedMethod): Boolean;
procedure Add(const Key: TMonoCacheKey; const Func: TSpecializedMethod);
end;
{ TStandardExecutionStrategy }
TStandardExecutionStrategy = class(TInterfacedObject, IExecutionStrategy)
public
@@ -244,11 +154,11 @@ type
FRootScope: IExecutionScope;
FMacroRegistry: IMacroRegistry;
FExecutionStrategy: IExecutionStrategy;
FMonomorphCache: TMonomorphCache;
FMonomorphCache: IMonomorphCache;
FFunctionRegistry: IFunctionDefinitionRegistry;
function GetRootScope: IExecutionScope;
function GetMacroRegistry: IMacroRegistry;
function GetMonomorphCache: TMonomorphCache;
function GetMonomorphCache: IMonomorphCache;
function GetFunctionRegistry: IFunctionDefinitionRegistry;
public
constructor Create(
@@ -256,8 +166,6 @@ type
const AMacroRegistry: IMacroRegistry;
const AExecutionStrategy: IExecutionStrategy
);
destructor Destroy; override;
function CreateEnvironment: IEnvironment;
procedure SetExecutionStrategy(const AStrategy: IExecutionStrategy);
@@ -415,17 +323,11 @@ begin
FRootScope := ARootScope;
FMacroRegistry := AMacroRegistry;
FExecutionStrategy := AExecutionStrategy;
FMonomorphCache := TMonomorphCache.Create(TMonoCacheKeyComparer.Create);
FMonomorphCache := TMonomorphCache.Create;
FFunctionRegistry := TFunctionDefinitionRegistry.Create;
end;
destructor TEnvironment.Destroy;
begin
FMonomorphCache.Free;
inherited Destroy;
end;
function TEnvironment.GetMonomorphCache: TMonomorphCache;
function TEnvironment.GetMonomorphCache: IMonomorphCache;
begin
Result := FMonomorphCache;
end;
@@ -464,60 +366,9 @@ function TEnvironment.Compile(
const Params: TArray<IIdentifierNode>;
const ArgTypes: TArray<IStaticType>
): TCompiledFunction;
var
layout: IScopeLayout;
descriptor: IScopeDescriptor;
funcType: IStaticType;
finalFunc: TDataValue.TFunc;
typedNode: IAstNode;
specialized: IAstNode;
tcoOptimized: IAstNode;
isPure: Boolean;
begin
// 0. Wrap in Lambda to create an isolatable compilation unit (scope)
var prg := TAst.LambdaExpr(Params, Node);
// 1. Expand Macros
var expanded := ExpandMacros(prg);
// 2. Bind & Check Types
typedNode := Bind(expanded, layout, ArgTypes);
// Retrieve the descriptor from the typed lambda node
// (The TypeChecker baked it into the new LambdaExpressionNode)
descriptor := typedNode.AsLambdaExpression.Descriptor;
Assert(Assigned(descriptor), 'Compiler Logic Error: Descriptor missing after type checking.');
funcType := typedNode.AsTypedNode.StaticType;
// 3. Specialize
specialized := Specialize(typedNode);
// 4. Optimize (TCO)
tcoOptimized := TAstTCO.Optimize(specialized);
// 5. Purity Inference
// Check the body of the optimized lambda for purity.
// Note: tcoOptimized is a LambdaExpressionNode. Its body is what we check.
isPure := TPurityAnalyzer.IsPure(tcoOptimized.AsLambdaExpression.Body);
// 6. Create Evaluator
var visitor := FExecutionStrategy.CreateVisitor(descriptor.CreateScope(FRootScope));
// Execute the AST to get the TFunc (Closure)
var closure := tcoOptimized.Accept(visitor).AsMethod();
// Wrap TCO handling for the final result
finalFunc :=
function(const Args: TArray<TDataValue>): TDataValue
begin
Result := closure(Args);
TEvaluatorVisitor.HandleTCO(Result);
end;
// Pass IsPure flag to the compiled function record
Result := TCompiledFunction.Create(finalFunc, funcType, isPure);
// Wrap in Lambda to create an isolatable compilation unit (scope)
Result := Compile(TAst.LambdaExpr(Params, Node).AsLambdaExpression, ArgTypes);
end;
function TEnvironment.Compile(const Node: IFunctionDefinition; const ArgTypes: TArray<IStaticType>): TCompiledFunction;
@@ -600,7 +451,85 @@ end;
function TEnvironment.Specialize(const Node: IAstNode): IAstNode;
begin
Result := TStaticSpecializer.Specialize(Self, Node);
Result :=
TStaticSpecializer.Specialize(
Node,
FMonomorphCache,
FFunctionRegistry,
function(const Node: IFunctionDefinition; const ArgTypes: TArray<IStaticType>): TCompiledFunction
begin
Result := Compile(Node, ArgTypes);
end
);
end;
{ TMonoCacheKeyComparer }
function TMonoCacheKeyComparer.Equals(const Left, Right: TMonoCacheKey): Boolean;
var
i: Integer;
begin
if not (Left.Address = Right.Address) then
exit(False);
if Length(Left.ArgTypes) <> Length(Right.ArgTypes) then
exit(False);
for i := 0 to High(Left.ArgTypes) do
begin
if not Left.ArgTypes[i].IsEqual(Right.ArgTypes[i]) then
exit(False);
end;
Result := True;
end;
function TMonoCacheKeyComparer.GetHashCode(const Value: TMonoCacheKey): Integer;
var
i: Integer;
hash: Integer;
typeHash: Integer;
adr: TResolvedAddress;
begin
adr := Value.Address;
hash := THashBobJenkins.GetHashValue(adr.Kind, SizeOf(TAddressKind), 0);
hash := THashBobJenkins.GetHashValue(adr.ScopeDepth, SizeOf(Integer), hash);
hash := THashBobJenkins.GetHashValue(adr.SlotIndex, SizeOf(Integer), hash);
for i := 0 to High(Value.ArgTypes) do
begin
if Assigned(Value.ArgTypes[i]) then
typeHash := Value.ArgTypes[i].GetHashCode
else
typeHash := 0;
hash := THashBobJenkins.GetHashValue(typeHash, SizeOf(Integer), hash);
end;
Result := hash;
end;
constructor TMonomorphCache.Create;
begin
inherited Create;
FMonomorphCache := TDictionary<TMonoCacheKey, TSpecializedMethod>.Create(TMonoCacheKeyComparer.Create);
end;
destructor TMonomorphCache.Destroy;
begin
FMonomorphCache.Free;
inherited Destroy;
end;
procedure TMonomorphCache.Add(const Key: TMonoCacheKey; const Func: TSpecializedMethod);
begin
FMonomorphCache.Add(Key, Func);
end;
function TMonomorphCache.TryGetFunction(const Key: TMonoCacheKey; out Func: TSpecializedMethod): Boolean;
begin
Result := FMonomorphCache.TryGetValue(Key, Func);
end;
end.