358 lines
10 KiB
ObjectPascal
358 lines
10 KiB
ObjectPascal
{
|
|
* A Child-Sibling Tree.
|
|
*
|
|
* A tree with PLUS at the root and with two children 3 and 4 is
|
|
* structured as:
|
|
*
|
|
* PLUS
|
|
* |
|
|
* 3 -- 4
|
|
*
|
|
* and can be specified easily in LISP notation as
|
|
*
|
|
* (PLUS 3 4)
|
|
*
|
|
* where every '(' starts a new subtree.
|
|
*
|
|
* These trees are particular useful for translators because of
|
|
* the flexibility of the children lists. They are also very easy
|
|
* to walk automatically, whereas trees with specific children
|
|
* reference fields can't easily be walked automatically.
|
|
*
|
|
* This class contains the basic support for an AST.
|
|
* Most people will create ASTs that are subclasses of
|
|
* BaseAST or of CommonAST.
|
|
*/
|
|
}
|
|
unit dpgrtl.astBase;
|
|
|
|
interface
|
|
uses
|
|
System.Classes,
|
|
Generics.Collections,
|
|
dpgrtl.Token;
|
|
|
|
|
|
type
|
|
TAST = class;
|
|
TASTList = TList<TAST>;
|
|
|
|
TAST = class
|
|
protected
|
|
fDown : TAST;
|
|
fRight : TAST;
|
|
|
|
fAstText : AnsiString;
|
|
fAstType : integer;
|
|
fAstLine : integer;
|
|
fAstColumn : integer;
|
|
|
|
private
|
|
fVerbose : boolean; // verbose string conversion
|
|
fTokenNames : TStringList;
|
|
|
|
private
|
|
procedure DoFindAll( NodeToSearch : TAST;
|
|
// v : Vector;
|
|
Target : TAST;
|
|
PartialMatch : boolean);
|
|
|
|
protected
|
|
function GetNumberofChildren: integer;
|
|
|
|
function GetEquals( Node : TAST): boolean; virtual;
|
|
function GetEqualsList( Node : TAST): boolean; virtual;
|
|
function GetEqualsListPartial( Node : TAST): boolean; virtual;
|
|
function GetEqualsTree( Node : TAST): boolean; virtual;
|
|
function GetEqualsTreePartial( Node : TAST): boolean; virtual;
|
|
|
|
function GetTokenNames : TStringList;
|
|
|
|
procedure SetVerbose( Verbose : boolean;
|
|
Names : TStringList);
|
|
|
|
public
|
|
procedure Initialize( AstType : integer;
|
|
AstText : AnsiString); overload; virtual; abstract;
|
|
|
|
procedure Initialize( Node : TAST); overload; virtual; abstract;
|
|
procedure Initialize( Token : TToken); overload; virtual; abstract;
|
|
|
|
procedure AddChild( node: TAST);
|
|
procedure RemoveChildren;
|
|
|
|
public
|
|
procedure AfterConstruction; override;
|
|
procedure BeforeDestruction; override;
|
|
|
|
public
|
|
property NumberOfChildren : integer read GetNumberofChildren;
|
|
|
|
property NextSibling : TAST read fRight write fRight;
|
|
property FirstChild : TAST read fDown write fDown;
|
|
|
|
property AstText : AnsiString read fAstText write fAstText;
|
|
property AstType : integer read fAstType write fAstType;
|
|
property AstLine : integer read fAstLine write fAstLine;
|
|
property AstColumn : integer read fAstColumn write fAstColumn;
|
|
|
|
property Equals [n: TAST]: boolean read GetEquals;
|
|
property EqualsList [n: TAST]: boolean read GetEqualsList;
|
|
property EqualsListPartial [n: TAST]: boolean read GetEqualsListPartial;
|
|
property EqualsTree [n: TAST]: boolean read GetEqualsTree;
|
|
property EqualsTreePartial [n: TAST]: boolean read GetEqualsTreepartial;
|
|
end;
|
|
|
|
TASTClass = class of TAST;
|
|
|
|
|
|
implementation
|
|
|
|
{ TastBase }
|
|
|
|
procedure TAST.AfterConstruction;
|
|
begin
|
|
inherited;
|
|
fTokenNames := TStringList.Create;
|
|
end;
|
|
|
|
procedure TAST.BeforeDestruction;
|
|
begin
|
|
fTokenNames.Free;
|
|
inherited;
|
|
end;
|
|
|
|
// ================================================================================================
|
|
// DoFindAll
|
|
// ================================================================================================
|
|
procedure TAST.DoFindAll(NodeToSearch, Target: TAST; PartialMatch: boolean);
|
|
var
|
|
sibling: TAST;
|
|
|
|
begin
|
|
// start walking sibling lists, looking for matches
|
|
sibling := NodeToSearch;
|
|
|
|
while Assigned(sibling) do
|
|
begin
|
|
if ( PartialMatch and sibling.EqualsTreePartial[Target]) or
|
|
( not PartialMatch and sibling.EqualsTree[Target]) then
|
|
// v.appendelement(sibling)
|
|
;
|
|
|
|
if Assigned( sibling.FirstChild) then
|
|
DoFindAll( sibling.FirstChild, {v,} Target, PartialMatch);
|
|
|
|
sibling := sibling.NextSibling
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
// ================================================================================================
|
|
// Get Number of Children
|
|
// ================================================================================================
|
|
function TAST.GetNumberofChildren: integer;
|
|
var
|
|
t: TAST;
|
|
n: integer;
|
|
|
|
begin
|
|
t := fDown;
|
|
n := 0;
|
|
|
|
if Assigned(t) then
|
|
begin
|
|
INC(n);
|
|
|
|
while Assigned(t.fRight) do
|
|
begin
|
|
t := t.fRight;
|
|
INC(n)
|
|
end;
|
|
end;
|
|
|
|
result := n
|
|
end;
|
|
|
|
// ================================================================================================
|
|
// Get Equals
|
|
// ================================================================================================
|
|
function TAST.GetEquals(Node: TAST): boolean;
|
|
begin
|
|
if Assigned(Node)
|
|
then result := (Node.fAstText = fAstText) and (Node.fAstType = fAstType)
|
|
else result := false
|
|
end;
|
|
|
|
// ================================================================================================
|
|
// Get Equals List
|
|
// ================================================================================================
|
|
function TAST.GetEqualsList(Node: TAST): boolean;
|
|
var
|
|
sibling: TAST;
|
|
|
|
begin
|
|
result := false;
|
|
|
|
if Assigned(Node) then
|
|
begin
|
|
sibling := self;
|
|
|
|
while Assigned(sibling) and Assigned(Node) do
|
|
begin
|
|
// as a quick optimization, check roots firt
|
|
if not sibling.Equals[Node] then
|
|
break;
|
|
|
|
// if roots match, do full list match test on children
|
|
if Assigned( sibling.FirstChild) then
|
|
begin
|
|
if not sibling.FirstChild.EqualsList[Node.FirstChild] then
|
|
break
|
|
end
|
|
|
|
// sibling has no kids, make sure Node doesn't either
|
|
else if Assigned(Node.FirstChild) then
|
|
break;
|
|
|
|
sibling := sibling .NextSibling;
|
|
Node := Node .NextSibling;
|
|
end;
|
|
|
|
if not Assigned(sibling) and not Assigned(Node) then
|
|
result := true
|
|
end;
|
|
end;
|
|
|
|
// ================================================================================================
|
|
// Get Equals List Partial
|
|
//
|
|
// Is Node a subtree of this list ? The siblings of the root are NOT ignored.
|
|
// ================================================================================================
|
|
function TAST.GetEqualsListPartial(Node: TAST): boolean;
|
|
var
|
|
sibling: TAST;
|
|
|
|
begin
|
|
result := false;
|
|
|
|
if Assigned(Node) then
|
|
begin
|
|
sibling := self;
|
|
|
|
while Assigned(sibling) and Assigned(Node) do
|
|
begin
|
|
// as a quick optimization, check roots firt
|
|
if not sibling.Equals[Node] then
|
|
break;
|
|
|
|
// if roots match, do partial list match test on children
|
|
if Assigned( sibling.FirstChild) then
|
|
if not sibling.FirstChild.EqualsListPartial[Node.FirstChild] then
|
|
break
|
|
end;
|
|
|
|
if not Assigned(sibling) and Assigned(Node)
|
|
then result := false
|
|
else result := true
|
|
end;
|
|
end;
|
|
|
|
// ================================================================================================
|
|
// Get Equals Tree
|
|
//
|
|
// Is the tree rooted at *self* equals to *Node* ?
|
|
// The sibling of *self* are ignored.
|
|
// ================================================================================================
|
|
function TAST.GetEqualsTree(Node: TAST): boolean;
|
|
begin
|
|
result := false;
|
|
|
|
if Equals[Node] then
|
|
begin
|
|
// if roots match, do full list match test on children
|
|
if Assigned(FirstChild) then
|
|
begin
|
|
if not FirstChild.EqualsList[Node.FirstChild] then
|
|
exit;
|
|
end
|
|
|
|
// No kids, make sure *Node* hasn't either
|
|
else if Assigned(Node.FirstChild) then
|
|
exit;
|
|
end;
|
|
|
|
result := true
|
|
end;
|
|
|
|
// ================================================================================================
|
|
// Get Equals Tree Partial
|
|
// ================================================================================================
|
|
function TAST.GetEqualsTreePartial(Node: TAST): boolean;
|
|
begin
|
|
result := false;
|
|
|
|
if Equals[Node] then
|
|
if Assigned(FirstChild) then
|
|
if not FirstChild.EqualsListPartial[Node] then
|
|
exit;
|
|
|
|
result := true
|
|
end;
|
|
|
|
// ================================================================================================
|
|
// Get Token Names
|
|
// ================================================================================================
|
|
function TAST.GetTokenNames: TStringList;
|
|
begin
|
|
result := TStringList.Create;
|
|
result.AddStrings(fTokenNames);
|
|
end;
|
|
|
|
// ================================================================================================
|
|
// Set Verbose
|
|
// ================================================================================================
|
|
procedure TAST.SetVerbose(Verbose: boolean; Names: TStringList);
|
|
begin
|
|
fVerbose := Verbose;
|
|
fTokenNames.Clear;
|
|
ftokenNames.AddStrings(Names);
|
|
end;
|
|
|
|
// ================================================================================================
|
|
// AddChild
|
|
// ================================================================================================
|
|
procedure TAST.AddChild(node: TAST);
|
|
var
|
|
n: TAST;
|
|
|
|
begin
|
|
if Assigned(node) then
|
|
begin
|
|
n := fDown;
|
|
|
|
if Assigned(n) then
|
|
begin
|
|
while Assigned(n.fRight) do
|
|
n := n.fRight;
|
|
|
|
n.fRight := node
|
|
end
|
|
|
|
else
|
|
fDown := node
|
|
end;
|
|
end;
|
|
|
|
// ================================================================================================
|
|
// Remove Children
|
|
// ================================================================================================
|
|
procedure TAST.RemoveChildren;
|
|
begin
|
|
fDown := nil
|
|
end;
|
|
|
|
|
|
end.
|