diff --git a/ASTPlayground/MainForm.pas b/ASTPlayground/MainForm.pas index 45e04d2..0e15bd2 100644 --- a/ASTPlayground/MainForm.pas +++ b/ASTPlayground/MainForm.pas @@ -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 diff --git a/Src/AST/Myc.Ast.Compiler.Binder.pas b/Src/AST/Myc.Ast.Compiler.Binder.pas index 7abf47f..bec53b9 100644 --- a/Src/AST/Myc.Ast.Compiler.Binder.pas +++ b/Src/AST/Myc.Ast.Compiler.Binder.pas @@ -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 diff --git a/Src/AST/Myc.Ast.Compiler.Macros.pas b/Src/AST/Myc.Ast.Compiler.Macros.pas index bf1229f..6f97ef8 100644 --- a/Src/AST/Myc.Ast.Compiler.Macros.pas +++ b/Src/AST/Myc.Ast.Compiler.Macros.pas @@ -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 diff --git a/Src/AST/Myc.Ast.Compiler.Specializer.pas b/Src/AST/Myc.Ast.Compiler.Specializer.pas index 4db470d..d62ee64 100644 --- a/Src/AST/Myc.Ast.Compiler.Specializer.pas +++ b/Src/AST/Myc.Ast.Compiler.Specializer.pas @@ -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; + Func: TDataValue.TFunc; + constructor Create(const AAddress: TResolvedAddress; const AArgTypes: TArray); + 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): TCompiledFunction; private - FEnvironment: IEnvironment; + FMonomorphCache: IMonomorphCache; + FFunctionRegistry: IFunctionDefinitionRegistry; + FCompileFunc: TCompileFunc; function GetStaticRtlFunction(const AName: string; const AArgTypes: TArray): 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); +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. diff --git a/Src/AST/Myc.Ast.Environment.pas b/Src/AST/Myc.Ast.Environment.pas index 45484c6..c87e39c 100644 --- a/Src/AST/Myc.Ast.Environment.pas +++ b/Src/AST/Myc.Ast.Environment.pas @@ -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; - constructor Create(const AAddress: TResolvedAddress; const AArgTypes: TArray); - end; - - TMonoCacheKeyComparer = class(TEqualityComparer) - public - function Equals(const Left, Right: TMonoCacheKey): Boolean; override; - function GetHashCode(const Value: TMonoCacheKey): Integer; override; - end; - - TMonomorphCache = TDictionary; - - 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); -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) + public + function Equals(const Left, Right: TMonoCacheKey): Boolean; override; + function GetHashCode(const Value: TMonoCacheKey): Integer; override; + end; + + TMonomorphCache = class(TInterfacedObject, IMonomorphCache) + private + FMonomorphCache: TDictionary; + 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; const ArgTypes: TArray ): 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 - 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): 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): 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.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.