350 lines
12 KiB
ObjectPascal
350 lines
12 KiB
ObjectPascal
// AST Support code shared by TreeParser and Parser.
|
|
// We use delegation to share code (and have only one
|
|
// bit of code to maintain) rather than subclassing
|
|
// or superclassing (forces AST support code to be
|
|
// loaded even when you don't want to do AST stuff).
|
|
//
|
|
// Typically, setASTNodeType is used to specify the
|
|
// homogeneous type of node to create, but you can override
|
|
// create to make heterogeneous nodes etc...
|
|
|
|
unit dpgrtl.astFactory;
|
|
|
|
interface
|
|
uses
|
|
Generics.Collections,
|
|
dpgrtl.types,
|
|
dpgrtl.astBase,
|
|
dpgrtl.astPair;
|
|
|
|
type
|
|
TTokenToASTMap = TDictionary<integer,TASTClass>;
|
|
|
|
TASTFactory = class
|
|
protected
|
|
// How to specify the classname to create for a particular
|
|
// token type. Note that DPG allows you to say, for example,
|
|
//
|
|
// tokens
|
|
// {
|
|
// PLUS<AST=PLUSNode>;
|
|
// ...
|
|
// }
|
|
//
|
|
// and it tracks everything statically. #[PLUS] will make you
|
|
// a PLUSNode w/o use of this table.
|
|
//
|
|
// For tokens that DPG cannot track statically like #[i],
|
|
// you can use this table to map PLUS (Integer) -> PLUSNode (Class)
|
|
// etc... DPG sets the class map from the tokens {...} section
|
|
// via the ASTFactory(Hashtable) ctor in antlr.Parser.
|
|
|
|
fASTNodeTypeName : AnsiString;
|
|
fASTNodeTypeClass : TASTClass;
|
|
|
|
fTokenToASTMap : TTokenToASTMap;
|
|
|
|
protected
|
|
function GetASTClass( TokenType: integer): TASTClass;
|
|
procedure SetASTClass( TokenType: integer; ASTClass: TASTClass);
|
|
|
|
public
|
|
function CreateAST( TokenType: integer=TT_INVALID;
|
|
TokenText: string = ''): TAST; overload;
|
|
|
|
function CreateAST( TokenType: integer;
|
|
TokenText: string;
|
|
ASTName : string) : TAST; overload;
|
|
|
|
function CreateAST( ASTName : string) : TAST; overload;
|
|
|
|
function CreateAST( AST : TAST) : TAST; overload;
|
|
function CreateAST( Token : IToken) : TAST; overload;
|
|
|
|
function Clone( AST : TAST) : TAST;
|
|
function CloneList( AST : TAST) : TAST;
|
|
function CloneTree( AST : TAST) : TAST;
|
|
|
|
function Make( Nodes : array of TAST) : TAST;
|
|
procedure MakeRoot( ASTPair : TASTPair;
|
|
Root : TAST);
|
|
|
|
|
|
public
|
|
constructor Create( map: TTokenToASTMap);
|
|
destructor Destroy; override;
|
|
|
|
public
|
|
property ASTClass[t: integer] : TASTClass read GetASTClass
|
|
write SetASTClass;
|
|
|
|
end;
|
|
|
|
|
|
implementation
|
|
uses
|
|
System.RTTI,
|
|
dpgrtl.astCommon,
|
|
System.SysUtils;
|
|
|
|
{ TASTFactory }
|
|
|
|
// ================================================================================================
|
|
// Constructor
|
|
// ================================================================================================
|
|
constructor TASTFactory.Create(map: TTokenToASTMap);
|
|
begin
|
|
inherited Create;
|
|
fTokenToASTMap := TTokenToASTMap.Create;
|
|
|
|
// SetTokenToASTMap(map);
|
|
end;
|
|
|
|
// ================================================================================================
|
|
// Destructor
|
|
// ================================================================================================
|
|
destructor TASTFactory.Destroy;
|
|
begin
|
|
FreeAndNil(fTokenToASTMap);
|
|
inherited;
|
|
end;
|
|
|
|
|
|
// @@@: Interface +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
|
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
|
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
|
//
|
|
// Interface
|
|
//
|
|
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
|
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
|
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
|
// ================================================================================================
|
|
// Create AST (TokenType,TokenText)
|
|
//
|
|
// Create a new empty AST node. If the user did not specify an AST node type, then create a
|
|
// default one: *TastCommon*
|
|
// ================================================================================================
|
|
function TASTFactory.CreateAST(TokenType: integer; TokenText: string): TAST;
|
|
begin
|
|
result := ASTClass[TokenType].Create;
|
|
|
|
if Assigned(result) then
|
|
result.Initialize( TokenType, AnsiString(TokenText));
|
|
end;
|
|
|
|
// ================================================================================================
|
|
// Create AST (AST Class Name)
|
|
// ================================================================================================
|
|
function TASTFactory.CreateAST(ASTName: string): TAST;
|
|
var
|
|
ctx : TRttiContext;
|
|
typ : TRttiType;
|
|
|
|
begin
|
|
result := nil;
|
|
ctx := TRttiContext.Create;
|
|
typ := ctx.FindType(ASTName);
|
|
|
|
if Assigned(typ) then
|
|
result := TASTClass(typ).Create;
|
|
end;
|
|
|
|
// ================================================================================================
|
|
// Create AST
|
|
// ================================================================================================
|
|
function TASTFactory.CreateAST(TokenType: integer; TokenText, ASTName: string): TAST;
|
|
begin
|
|
result := CreateAST( ASTName);
|
|
|
|
if Assigned(result) then
|
|
result.Initialize( TokenType, AnsiString(TokenText))
|
|
end;
|
|
|
|
// ================================================================================================
|
|
// Create AST
|
|
// ================================================================================================
|
|
function TASTFactory.CreateAST(AST: TAST): TAST;
|
|
begin
|
|
result := nil;
|
|
|
|
if Assigned(AST) then
|
|
result := CreateAST(AST.ClassName);
|
|
|
|
if Assigned(result) then
|
|
result.Initialize( AST.AstType, AST.AstText);
|
|
end;
|
|
|
|
// ================================================================================================
|
|
// Create AST
|
|
// ================================================================================================
|
|
function TASTFactory.CreateAST(Token: IToken): TAST;
|
|
begin
|
|
result := nil;
|
|
|
|
if Assigned(Token) then
|
|
result := CreateAST( Token.TokenType, string(Token.TokenText))
|
|
end;
|
|
|
|
// ================================================================================================
|
|
// Clone
|
|
// ================================================================================================
|
|
function TASTFactory.Clone( AST: TAST) : TAST;
|
|
begin
|
|
result := nil;
|
|
|
|
if Assigned(AST) then
|
|
result := CreateAST(AST);
|
|
end;
|
|
|
|
// ================================================================================================
|
|
// Clone List
|
|
//
|
|
// Duplicate a tree including siblings of root.
|
|
// ================================================================================================
|
|
function TASTFactory.CloneList( AST: TAST): TAST;
|
|
var
|
|
nt: TAST;
|
|
|
|
begin
|
|
result := CloneTree(AST);
|
|
nt := result;
|
|
|
|
while Assigned(AST) do
|
|
begin
|
|
AST := AST.NextSibling;
|
|
|
|
nt.NextSibling := CloneTree(AST);
|
|
nt := nt.NextSibling;
|
|
end;
|
|
end;
|
|
|
|
// ================================================================================================
|
|
// Clone Tree
|
|
//
|
|
// Duplicate a tree, assuming this is a root node of a tree.
|
|
// Duplicate that node and what's below; ignore siblings of a root node.
|
|
// ================================================================================================
|
|
function TASTFactory.CloneTree( AST: TAST): TAST;
|
|
begin
|
|
result := Clone(AST);
|
|
|
|
if Assigned(result) then
|
|
result.FirstChild := CloneList( AST.FirstChild)
|
|
end;
|
|
|
|
// ================================================================================================
|
|
// Make
|
|
//
|
|
// Make a tree from a list of nodes. The first element in the array is the root.
|
|
// If the root is null, then the tree is a simple list not a tree.
|
|
// Handles null children nodes correctly.
|
|
//
|
|
// For example, build(a, b, null, c) yields tree (a b c).
|
|
// build(null,a,b) yields tree (nil a b).
|
|
// ================================================================================================
|
|
function TASTFactory.Make(Nodes: array of TAST): TAST;
|
|
var
|
|
i : integer;
|
|
root : TAST;
|
|
tail : TAST;
|
|
|
|
begin
|
|
result := nil;
|
|
|
|
if Length(Nodes) > 0 then
|
|
begin
|
|
root := Nodes[Low(Nodes)];
|
|
tail := nil;
|
|
|
|
if Assigned(root) then
|
|
root.FirstChild := nil;
|
|
|
|
// link in children
|
|
for i:=Low(Nodes)+1 to High(Nodes) do
|
|
begin
|
|
// ignore nil nodes
|
|
if Nodes[i] = nil then
|
|
continue;
|
|
|
|
if not Assigned(root) then
|
|
begin
|
|
root := nodes[i];
|
|
tail := nodes[i];
|
|
end
|
|
|
|
else if not Assigned(tail) then
|
|
begin
|
|
root.FirstChild := Nodes[i];
|
|
tail := root.FirstChild;
|
|
end
|
|
|
|
else begin
|
|
tail.NextSibling:= Nodes[i];
|
|
tail := tail.NextSibling;
|
|
end;
|
|
|
|
while Assigned(tail.NextSibling) do
|
|
tail := tail.NextSibling;
|
|
end
|
|
end
|
|
end;
|
|
|
|
// ================================================================================================
|
|
// Make root
|
|
// ================================================================================================
|
|
procedure TASTFactory.MakeRoot(ASTPair: TASTPair; Root: TAST);
|
|
begin
|
|
if Assigned(Root) then
|
|
begin
|
|
Root.AddChild(ASTPair.Root);
|
|
|
|
ASTPair.Child := ASTPair.Root;
|
|
ASTPair.AdvanceChildToEnd;
|
|
ASTPair.Root := Root;
|
|
end
|
|
end;
|
|
|
|
// @@@: Property handlers +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
|
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
|
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
|
//
|
|
// Property handlers
|
|
//
|
|
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
|
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
|
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
|
// ================================================================================================
|
|
// Get the AST class that assigned to a token type
|
|
// ================================================================================================
|
|
function TASTFactory.GetASTClass(TokenType: integer): TASTClass;
|
|
begin
|
|
result := nil;
|
|
|
|
if Assigned( fTokenToASTMap) then
|
|
fTokenToASTMap.TryGetValue( TokenType, result);
|
|
|
|
if not Assigned(result) then
|
|
result := fASTNodeTypeClass;
|
|
|
|
if not Assigned(result) then
|
|
result := TastCommon;
|
|
end;
|
|
|
|
// ================================================================================================
|
|
// Assign an AST class to a token type
|
|
// ================================================================================================
|
|
procedure TASTFactory.SetASTClass(TokenType: integer; ASTClass: TASTClass);
|
|
begin
|
|
if Assigned( fTokenToASTMap) then
|
|
begin
|
|
if fTokenToASTMap.ContainsKey(TokenType) then
|
|
fTokenToASTMap.Remove(TokenType);
|
|
|
|
if Assigned(ASTClass) then
|
|
fTokenToASTMap.Add(TokenType,ASTClass)
|
|
end
|
|
end;
|
|
|
|
end.
|