Resolved cyclic dependencies between environment and compiler stages
This commit is contained in:
Michael Schimmel
+111
-182
@@ -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.
|
||||
|
||||
Reference in New Issue
Block a user