PageRenderTime 40ms CodeModel.GetById 19ms app.highlight 9ms RepoModel.GetById 1ms app.codeStats 1ms

/components/codetools/codegraph.pas

http://github.com/graemeg/lazarus
Pascal | 1003 lines | 853 code | 77 blank | 73 comment | 150 complexity | bd91af9f079447cfeb8d5db6aaedc03d MD5 | raw file
   1{
   2 ***************************************************************************
   3 *                                                                         *
   4 *   This source is free software; you can redistribute it and/or modify   *
   5 *   it under the terms of the GNU General Public License as published by  *
   6 *   the Free Software Foundation; either version 2 of the License, or     *
   7 *   (at your option) any later version.                                   *
   8 *                                                                         *
   9 *   This code is distributed in the hope that it will be useful, but      *
  10 *   WITHOUT ANY WARRANTY; without even the implied warranty of            *
  11 *   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     *
  12 *   General Public License for more details.                              *
  13 *                                                                         *
  14 *   A copy of the GNU General Public License is available on the World    *
  15 *   Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also      *
  16 *   obtain it by writing to the Free Software Foundation,                 *
  17 *   Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.        *
  18 *                                                                         *
  19 ***************************************************************************
  20
  21  Author: Mattias Gaertner
  22
  23  Abstract:
  24    An arbitrary graph for TCodeTreeNode.
  25}
  26unit CodeGraph; 
  27
  28{$mode objfpc}{$H+}
  29
  30interface
  31
  32uses
  33  Classes, SysUtils, CodeTree, FileProcs, AVL_Tree;
  34  
  35type
  36
  37  { TCodeGraphNode }
  38
  39  TCodeGraphNode = class
  40  private
  41    FInternalFlags: integer;
  42  public
  43    Node: TCodeTreeNode;
  44    InTree: TAVLTree;// tree of TCodeGraphEdge sorted for FromNode (ToNode = Self)
  45    OutTree: TAVLTree;// tree of TCodeGraphEdge sorted for ToNode (FromNode = Self)
  46    Data: Pointer;  // custom data
  47    Flags: cardinal;// custom flags
  48    function OutTreeCount: integer;
  49    function InTreeCount: integer;
  50  end;
  51  TCodeGraphNodeClass = class of TCodeGraphNode;
  52  
  53  PCodeGraphEdgeKey = ^TCodeGraphEdgeKey;
  54  TCodeGraphEdgeKey = record
  55    FromNode: TCodeTreeNode;
  56    ToNode: TCodeTreeNode;
  57  end;
  58
  59  { TCodeGraphEdge }
  60
  61  TCodeGraphEdge = class
  62  private
  63    FInternalFlags: integer;
  64  public
  65    FromNode: TCodeGraphNode;
  66    ToNode: TCodeGraphNode;
  67    Data: Pointer;  // custom data
  68    Flags: cardinal;// custom flags
  69  end;
  70  TCodeGraphEdgeClass = class of TCodeGraphEdge;
  71
  72  { TCodeGraph }
  73
  74  TCodeGraph = class
  75  private
  76    FEdgeClass: TCodeGraphEdgeClass;
  77    FNodeClass: TCodeGraphNodeClass;
  78    procedure ClearInternalNodeFlags;
  79  public
  80    Nodes: TAVLTree; // tree of TCodeGraphNode sorted for Node
  81    Edges: TAVLTree; // tree of TCodeGraphEdge sorted for FromNode,ToNode
  82    constructor Create(ANodeClass: TCodeGraphNodeClass = nil;
  83                       AnEdgeClass: TCodeGraphEdgeClass = nil);
  84    destructor Destroy; override;
  85    procedure Clear;
  86    procedure ClearNodeFlags;
  87    procedure ClearEdgeFlags;
  88    procedure Assign(Source: TCodeGraph);
  89    function CreateCopy: TCodeGraph;
  90    function AddGraphNode(Node: TCodeTreeNode): TCodeGraphNode;
  91    function GetGraphNode(Node: TCodeTreeNode; CreateIfNotExists: boolean
  92                          ): TCodeGraphNode;
  93    procedure DeleteGraphNode(Node: TCodeTreeNode);
  94    function FindGraphNodeWithNumberOfOutEdges(MinNumber, MaxNumber: integer
  95                                               ): TCodeGraphNode;
  96    function FindGraphNodeWithNumberOfInEdges(MinNumber, MaxNumber: integer
  97                                              ): TCodeGraphNode;
  98
  99    function PathExists(FromNode, ToNode: TCodeTreeNode): boolean;
 100    function AddEdge(FromNode, ToNode: TCodeTreeNode): TCodeGraphEdge;
 101    function GetEdge(FromNode, ToNode: TCodeTreeNode;
 102                     CreateIfNotExists: boolean): TCodeGraphEdge;
 103    procedure DeleteEdge(FromNode, ToNode: TCodeTreeNode);
 104    procedure DeleteEdge(Edge: TCodeGraphEdge);
 105    procedure DeleteSelfCircles;
 106    procedure CombineNodes(ListOfGraphNodes: TFPList; GraphNode: TCodeGraphNode);
 107    function GetTopologicalSortedList(out ListOfGraphNodes: TFPList;
 108                    InEdgeDirection, // true=start with source nodes (no InEdges)
 109                    SetTopologicalLvl,// true=set Node.Flags to level
 110                    SortForStartPos: boolean// true=secondary sort order is Node.StartPos
 111                    ): TCodeGraphEdge;// is a circle edge (if found, else nil)
 112    procedure GetMaximumCircle(StartNode: TCodeGraphNode;
 113                               out ListOfGraphNodes: TFPList);
 114
 115    function FindAVLNodeOfNode(Node: TCodeTreeNode): TAVLTreeNode;
 116    function FindAVLNodeOfToNode(InTree: TAVLTree; ToNode: TCodeTreeNode
 117                                 ): TAVLTreeNode;
 118    function FindAVLNodeOfFromNode(OutTree: TAVLTree; FromNode: TCodeTreeNode
 119                                   ): TAVLTreeNode;
 120    function FindAVLNodeOfEdge(FromNode, ToNode: TCodeTreeNode): TAVLTreeNode;
 121    
 122    property NodeClass: TCodeGraphNodeClass read FNodeClass;
 123    property EdgeClass: TCodeGraphEdgeClass read FEdgeClass;
 124
 125    procedure ConsistencyCheck;
 126  end;
 127  
 128function CompareGraphNodeByNode(GraphNode1, GraphNode2: Pointer): integer;
 129function CompareNodeWithGraphNodeNode(p, GraphNode: Pointer): integer;
 130
 131function CompareGraphEdgeByFromNode(GraphEdge1, GraphEdge2: Pointer): integer;
 132function CompareNodeWithGraphEdgeFromNode(p, GraphEdge: Pointer): integer;
 133function CompareGraphEdgeByToNode(GraphEdge1, GraphEdge2: Pointer): integer;
 134function CompareNodeWithGraphEdgeToNode(p, GraphEdge: Pointer): integer;
 135
 136function CompareGraphEdgeByNodes(GraphEdge1, GraphEdge2: Pointer): integer;
 137function CompareEdgeKeyWithGraphEdge(EdgeKey, GraphEdge: Pointer): integer;
 138
 139implementation
 140
 141function CompareGraphNodeByNode(GraphNode1, GraphNode2: Pointer): integer;
 142var
 143  Node1: TCodeTreeNode;
 144  Node2: TCodeTreeNode;
 145begin
 146  Node1:=TCodeGraphNode(GraphNode1).Node;
 147  Node2:=TCodeGraphNode(GraphNode2).Node;
 148  if Pointer(Node1)>Pointer(Node2) then
 149    Result:=1
 150  else if Pointer(Node1)<Pointer(Node2) then
 151    Result:=-1
 152  else
 153    Result:=0;
 154  //DebugLn(['CompareGraphNodeByNode ',Node1.DescAsString,' ',Node2.DescAsString,' ',Result]);
 155end;
 156
 157function CompareNodeWithGraphNodeNode(p, GraphNode: Pointer): integer;
 158var
 159  Node: TCodeTreeNode;
 160begin
 161  Node:=TCodeGraphNode(GraphNode).Node;
 162  if p>Pointer(Node) then
 163    Result:=1
 164  else if p<Pointer(Node) then
 165    Result:=-1
 166  else
 167    Result:=0;
 168  //DebugLn(['ComparePointerWithGraphNodeNode ',TCodeTreeNode(p).DescAsString,' ',Node.DescAsString,' ',Result]);
 169end;
 170
 171function CompareGraphEdgeByFromNode(GraphEdge1, GraphEdge2: Pointer): integer;
 172var
 173  Node1: TCodeTreeNode;
 174  Node2: TCodeTreeNode;
 175begin
 176  Node1:=TCodeGraphEdge(GraphEdge1).FromNode.Node;
 177  Node2:=TCodeGraphEdge(GraphEdge2).FromNode.Node;
 178  if Pointer(Node1)>Pointer(Node2) then
 179    Result:=1
 180  else if Pointer(Node1)<Pointer(Node2) then
 181    Result:=-1
 182  else
 183    Result:=0;
 184end;
 185
 186function CompareNodeWithGraphEdgeFromNode(p, GraphEdge: Pointer): integer;
 187var
 188  Node: TCodeTreeNode;
 189begin
 190  Node:=TCodeGraphEdge(GraphEdge).FromNode.Node;
 191  if p>Pointer(Node) then
 192    Result:=1
 193  else if p<Pointer(Node) then
 194    Result:=-1
 195  else
 196    Result:=0;
 197end;
 198
 199function CompareGraphEdgeByToNode(GraphEdge1, GraphEdge2: Pointer): integer;
 200var
 201  Node1: TCodeTreeNode;
 202  Node2: TCodeTreeNode;
 203begin
 204  Node1:=TCodeGraphEdge(GraphEdge1).ToNode.Node;
 205  Node2:=TCodeGraphEdge(GraphEdge2).ToNode.Node;
 206  if Pointer(Node1)>Pointer(Node2) then
 207    Result:=1
 208  else if Pointer(Node1)<Pointer(Node2) then
 209    Result:=-1
 210  else
 211    Result:=0;
 212end;
 213
 214function CompareNodeWithGraphEdgeToNode(p, GraphEdge: Pointer): integer;
 215var
 216  Node: TCodeTreeNode;
 217begin
 218  Node:=TCodeGraphEdge(GraphEdge).ToNode.Node;
 219  if p>Pointer(Node) then
 220    Result:=1
 221  else if p<Pointer(Node) then
 222    Result:=-1
 223  else
 224    Result:=0;
 225end;
 226
 227function CompareGraphEdgeByNodes(GraphEdge1, GraphEdge2: Pointer): integer;
 228var
 229  Node1: TCodeTreeNode;
 230  Node2: TCodeTreeNode;
 231begin
 232  Node1:=TCodeGraphEdge(GraphEdge1).FromNode.Node;
 233  Node2:=TCodeGraphEdge(GraphEdge2).FromNode.Node;
 234  if Pointer(Node1)>Pointer(Node2) then
 235    exit(1)
 236  else if Pointer(Node1)<Pointer(Node2) then
 237    exit(-1);
 238  Node1:=TCodeGraphEdge(GraphEdge1).ToNode.Node;
 239  Node2:=TCodeGraphEdge(GraphEdge2).ToNode.Node;
 240  if Pointer(Node1)>Pointer(Node2) then
 241    exit(1)
 242  else if Pointer(Node1)<Pointer(Node2) then
 243    exit(-1);
 244  Result:=0;
 245end;
 246
 247function CompareEdgeKeyWithGraphEdge(EdgeKey, GraphEdge: Pointer): integer;
 248var
 249  Key: PCodeGraphEdgeKey;
 250  Edge: TCodeGraphEdge;
 251  Node1: TCodeTreeNode;
 252  Node2: TCodeTreeNode;
 253begin
 254  Key:=PCodeGraphEdgeKey(EdgeKey);
 255  Edge:=TCodeGraphEdge(GraphEdge);
 256  Node1:=Key^.FromNode;
 257  Node2:=Edge.FromNode.Node;
 258  if Pointer(Node1)>Pointer(Node2) then
 259    exit(1)
 260  else if Pointer(Node1)<Pointer(Node2) then
 261    exit(-1);
 262  Node1:=Key^.ToNode;
 263  Node2:=Edge.ToNode.Node;
 264  if Pointer(Node1)>Pointer(Node2) then
 265    exit(1)
 266  else if Pointer(Node1)<Pointer(Node2) then
 267    exit(-1);
 268  Result:=0;
 269end;
 270
 271function CompareGraphNodesForTopoLvlAndStartPos(
 272  GraphNode1, GraphNode2: Pointer): integer;
 273// 1 if lower Level (FInternalFlags) or if lvl is the same and lower Node.StartPos
 274var
 275  Level1: LongInt;
 276  Level2: LongInt;
 277  StartPos1: LongInt;
 278  StartPos2: LongInt;
 279begin
 280  Level1:=TCodeGraphNode(GraphNode1).FInternalFlags;
 281  Level2:=TCodeGraphNode(GraphNode2).FInternalFlags;
 282  if Level1<Level2 then
 283    Result:=1
 284  else if Level1>Level2 then
 285    Result:=-1
 286  else begin
 287    StartPos1:=TCodeGraphNode(GraphNode1).Node.StartPos;
 288    StartPos2:=TCodeGraphNode(GraphNode2).Node.StartPos;
 289    if StartPos1<StartPos2 then
 290      Result:=1
 291    else if StartPos1>StartPos2 then
 292      Result:=-1
 293    else
 294      Result:=0;
 295  end;
 296end;
 297
 298{ TCodeGraph }
 299
 300procedure TCodeGraph.ClearInternalNodeFlags;
 301var
 302  AVLNode: TAVLTreeNode;
 303begin
 304  AVLNode:=Nodes.FindLowest;
 305  while AVLNode<>nil do begin
 306    TCodeGraphNode(AVLNode.Data).FInternalFlags:=0;
 307    AVLNode:=Nodes.FindSuccessor(AVLNode);
 308  end;
 309end;
 310
 311constructor TCodeGraph.Create(ANodeClass: TCodeGraphNodeClass;
 312  AnEdgeClass: TCodeGraphEdgeClass);
 313begin
 314  if ANodeClass<>nil then
 315    FNodeClass:=ANodeClass
 316  else
 317    FNodeClass:=TCodeGraphNode;
 318  if AnEdgeClass<>nil then
 319    FEdgeClass:=AnEdgeClass
 320  else
 321    FEdgeClass:=TCodeGraphEdge;
 322  Nodes:=TAVLTree.Create(@CompareGraphNodeByNode);
 323  Edges:=TAVLTree.Create(@CompareGraphEdgeByNodes);
 324end;
 325
 326destructor TCodeGraph.Destroy;
 327begin
 328  Clear;
 329  FreeAndNil(Nodes);
 330  FreeAndNil(Edges);
 331  inherited Destroy;
 332end;
 333
 334procedure TCodeGraph.Clear;
 335var
 336  AVLNode: TAVLTreeNode;
 337  GraphNode: TCodeGraphNode;
 338begin
 339  AVLNode:=Nodes.FindLowest;
 340  while AVLNode<>nil do begin
 341    GraphNode:=TCodeGraphNode(AVLNode.Data);
 342    if GraphNode.InTree<>nil then begin
 343      GraphNode.InTree.FreeAndClear;// free the TCodeGraphEdge objects
 344      FreeAndNil(GraphNode.InTree);// free the InTree
 345    end;
 346    if GraphNode.OutTree<>nil then
 347      FreeAndNil(GraphNode.OutTree);// free the OutTree
 348    AVLNode:=Nodes.FindSuccessor(AVLNode);
 349  end;
 350  Nodes.FreeAndClear;// free the TCodeGraphNode objects
 351  Edges.Clear;
 352end;
 353
 354procedure TCodeGraph.ClearNodeFlags;
 355var
 356  AVLNode: TAVLTreeNode;
 357begin
 358  AVLNode:=Nodes.FindLowest;
 359  while AVLNode<>nil do begin
 360    TCodeGraphNode(AVLNode.Data).Flags:=0;
 361    TCodeGraphNode(AVLNode.Data).FInternalFlags:=0;
 362    AVLNode:=Nodes.FindSuccessor(AVLNode);
 363  end;
 364end;
 365
 366procedure TCodeGraph.ClearEdgeFlags;
 367var
 368  AVLNode: TAVLTreeNode;
 369begin
 370  AVLNode:=Edges.FindLowest;
 371  while AVLNode<>nil do begin
 372    TCodeGraphEdge(AVLNode.Data).Flags:=0;
 373    TCodeGraphEdge(AVLNode.Data).FInternalFlags:=0;
 374    AVLNode:=Edges.FindSuccessor(AVLNode);
 375  end;
 376end;
 377
 378procedure TCodeGraph.Assign(Source: TCodeGraph);
 379var
 380  AVLNode: TAVLTreeNode;
 381  GraphNode: TCodeGraphNode;
 382  SrcGraphNode: TCodeGraphNode;
 383  SrcGraphEdge: TCodeGraphEdge;
 384  GraphEdge: TCodeGraphEdge;
 385begin
 386  if Source=Self then exit;
 387  Clear;
 388  FNodeClass:=Source.FNodeClass;
 389  FEdgeClass:=Source.FEdgeClass;
 390  // copy nodes
 391  AVLNode:=Source.Nodes.FindLowest;
 392  while AVLNode<>nil do begin
 393    SrcGraphNode:=TCodeGraphNode(AVLNode.Data);
 394    GraphNode:=AddGraphNode(SrcGraphNode.Node);
 395    GraphNode.Data:=SrcGraphNode.Data;
 396    AVLNode:=Source.Nodes.FindSuccessor(AVLNode);
 397  end;
 398  // copy edges
 399  AVLNode:=Source.Edges.FindLowest;
 400  while AVLNode<>nil do begin
 401    SrcGraphEdge:=TCodeGraphEdge(AVLNode.Data);
 402    GraphEdge:=AddEdge(SrcGraphEdge.FromNode.Node,SrcGraphEdge.ToNode.Node);
 403    GraphEdge.Data:=SrcGraphEdge.Data;
 404    AVLNode:=Source.Edges.FindSuccessor(AVLNode);
 405  end;
 406end;
 407
 408function TCodeGraph.CreateCopy: TCodeGraph;
 409begin
 410  Result:=TCodeGraph.Create;
 411  Result.Assign(Self);
 412end;
 413
 414function TCodeGraph.AddGraphNode(Node: TCodeTreeNode): TCodeGraphNode;
 415begin
 416  Result:=GetGraphNode(Node,true);
 417end;
 418
 419function TCodeGraph.GetGraphNode(Node: TCodeTreeNode; CreateIfNotExists: boolean
 420  ): TCodeGraphNode;
 421var
 422  AVLNode: TAVLTreeNode;
 423begin
 424  if Node=nil then exit(nil);
 425  AVLNode:=FindAVLNodeOfNode(Node);
 426  if AVLNode<>nil then
 427    Result:=TCodeGraphNode(AVLNode.Data)
 428  else if CreateIfNotExists then begin
 429    Result:=FNodeClass.Create;
 430    Result.Node:=Node;
 431    Nodes.Add(Result);
 432  end else
 433    Result:=nil;
 434end;
 435
 436procedure TCodeGraph.DeleteGraphNode(Node: TCodeTreeNode);
 437var
 438  AVLNode: TAVLTreeNode;
 439  GraphNode: TCodeGraphNode;
 440  OutAVLNode: TAVLTreeNode;
 441  Edge: TCodeGraphEdge;
 442  InTree: TAVLTree;
 443  OutTree: TAVLTree;
 444  InAVLNode: TAVLTreeNode;
 445begin
 446  AVLNode:=FindAVLNodeOfNode(Node);
 447  if AVLNode=nil then exit;
 448  GraphNode:=TCodeGraphNode(AVLNode.Data);
 449  OutTree:=GraphNode.OutTree;
 450  if OutTree<>nil then begin
 451    // remove all edges coming from this Node
 452    OutAVLNode:=OutTree.FindLowest;
 453    while OutAVLNode<>nil do begin
 454      Edge:=TCodeGraphEdge(OutAVLNode.Data);
 455      InTree:=Edge.ToNode.InTree;
 456      InTree.Remove(Edge);
 457      Edges.Remove(Edge);
 458      Edge.Free;
 459      OutAVLNode:=OutTree.FindSuccessor(OutAVLNode);
 460    end;
 461    OutTree.Free;
 462  end;
 463  InTree:=GraphNode.InTree;
 464  if InTree<>nil then begin
 465    // remove all edges going to this Node
 466    InAVLNode:=InTree.FindLowest;
 467    while InAVLNode<>nil do begin
 468      Edge:=TCodeGraphEdge(InAVLNode.Data);
 469      OutTree:=Edge.FromNode.OutTree;
 470      OutTree.Remove(Edge);
 471      Edges.Remove(Edge);
 472      Edge.Free;
 473      InAVLNode:=InTree.FindSuccessor(InAVLNode);
 474    end;
 475    InTree.Free;
 476  end;
 477  Nodes.Delete(AVLNode);
 478  GraphNode.Free;
 479end;
 480
 481function TCodeGraph.FindGraphNodeWithNumberOfOutEdges(MinNumber,
 482  MaxNumber: integer): TCodeGraphNode;
 483var
 484  AVLNode: TAVLTreeNode;
 485  Cnt: LongInt;
 486begin
 487  AVLNode:=Nodes.FindLowest;
 488  while AVLNode<>nil do begin
 489    Result:=TCodeGraphNode(AVLNode.Data);
 490    Cnt:=Result.OutTreeCount;
 491    if ((MinNumber<0) or (MinNumber<=Cnt))
 492    and ((MaxNumber<0) or (MaxNumber>=Cnt)) then
 493      exit;
 494    AVLNode:=Nodes.FindSuccessor(AVLNode);
 495  end;
 496  Result:=nil;
 497end;
 498
 499function TCodeGraph.FindGraphNodeWithNumberOfInEdges(MinNumber,
 500  MaxNumber: integer): TCodeGraphNode;
 501var
 502  AVLNode: TAVLTreeNode;
 503  Cnt: LongInt;
 504begin
 505  AVLNode:=Nodes.FindLowest;
 506  while AVLNode<>nil do begin
 507    Result:=TCodeGraphNode(AVLNode.Data);
 508    Cnt:=Result.InTreeCount;
 509    if ((MinNumber<0) or (MinNumber<=Cnt))
 510    and ((MaxNumber<0) or (MaxNumber>=Cnt)) then
 511      exit;
 512    AVLNode:=Nodes.FindSuccessor(AVLNode);
 513  end;
 514  Result:=nil;
 515end;
 516
 517function TCodeGraph.PathExists(FromNode, ToNode: TCodeTreeNode): boolean;
 518
 519  function Search(GraphNode: TCodeGraphNode): boolean;
 520  var
 521    AVLNode: TAVLTreeNode;
 522    GraphEdge: TCodeGraphEdge;
 523  begin
 524    Result:=false;
 525    if GraphNode=nil then exit;
 526    if GraphNode.Node=ToNode then exit(true);
 527    if GraphNode.FInternalFlags>0 then exit;
 528    GraphNode.FInternalFlags:=1;
 529    if GraphNode.OutTree=nil then exit;
 530    AVLNode:=GraphNode.OutTree.FindLowest;
 531    while AVLNode<>nil do begin
 532      GraphEdge:=TCodeGraphEdge(AVLNode.Data);
 533      if Search(GraphEdge.ToNode) then exit(true);
 534      AVLNode:=GraphNode.OutTree.FindSuccessor(AVLNode);
 535    end;
 536  end;
 537
 538begin
 539  Result:=false;
 540  ClearInternalNodeFlags;
 541  Result:=Search(GetGraphNode(FromNode,false));
 542end;
 543
 544function TCodeGraph.AddEdge(FromNode, ToNode: TCodeTreeNode): TCodeGraphEdge;
 545begin
 546  Result:=GetEdge(FromNode,ToNode,true);
 547end;
 548
 549procedure TCodeGraph.DeleteEdge(FromNode, ToNode: TCodeTreeNode);
 550begin
 551  DeleteEdge(GetEdge(FromNode,ToNode,false));
 552end;
 553
 554procedure TCodeGraph.DeleteEdge(Edge: TCodeGraphEdge);
 555begin
 556  if Edge=nil then exit;
 557  Edge.FromNode.OutTree.Remove(Edge);
 558  Edge.ToNode.InTree.Remove(Edge);
 559  Edges.Remove(Edge);
 560  Edge.Free;
 561end;
 562
 563procedure TCodeGraph.DeleteSelfCircles;
 564var
 565  AVLNode: TAVLTreeNode;
 566  NextNode: TAVLTreeNode;
 567  Edge: TCodeGraphEdge;
 568begin
 569  AVLNode:=Edges.FindLowest;
 570  while AVLNode<>nil do begin
 571    NextNode:=Edges.FindSuccessor(AVLNode);
 572    Edge:=TCodeGraphEdge(AVLNode.Data);
 573    if Edge.FromNode=Edge.ToNode then
 574      DeleteEdge(Edge);
 575    AVLNode:=NextNode;
 576  end;
 577end;
 578
 579procedure TCodeGraph.CombineNodes(ListOfGraphNodes: TFPList;
 580  GraphNode: TCodeGraphNode);
 581// combines all nodes in ListOfGraphNodes into the super node Node
 582var
 583  i: Integer;
 584  CurGraphNode: TCodeGraphNode;
 585  AVLNode: TAVLTreeNode;
 586  Edge: TCodeGraphEdge;
 587begin
 588  if ListOfGraphNodes=nil then exit;
 589  // create for each edge to/from the List an edge to the super node
 590  for i:=0 to ListOfGraphNodes.Count-1 do begin
 591    CurGraphNode:=TCodeGraphNode(ListOfGraphNodes[i]);
 592    if CurGraphNode=GraphNode then continue;
 593    if CurGraphNode.InTree<>nil then begin
 594      AVLNode:=CurGraphNode.InTree.FindLowest;
 595      while AVLNode<>nil do begin
 596        Edge:=TCodeGraphEdge(AVLNode.Data);
 597        // add an edge to super node
 598        if Edge.FromNode<>GraphNode then
 599          AddEdge(Edge.FromNode.Node,GraphNode.Node);
 600        AVLNode:=CurGraphNode.InTree.FindSuccessor(AVLNode);
 601      end;
 602    end;
 603    if CurGraphNode.OutTree<>nil then begin
 604      AVLNode:=CurGraphNode.OutTree.FindLowest;
 605      while AVLNode<>nil do begin
 606        Edge:=TCodeGraphEdge(AVLNode.Data);
 607        // add an edge from super node
 608        if Edge.ToNode<>GraphNode then
 609          AddEdge(GraphNode.Node,Edge.ToNode.Node);
 610        AVLNode:=CurGraphNode.OutTree.FindSuccessor(AVLNode);
 611      end;
 612    end;
 613  end;
 614  // delete list nodes
 615  for i:=0 to ListOfGraphNodes.Count-1 do begin
 616    CurGraphNode:=TCodeGraphNode(ListOfGraphNodes[i]);
 617    if CurGraphNode=GraphNode then continue;
 618    // remove list node
 619    DeleteGraphNode(CurGraphNode.Node);
 620  end;
 621end;
 622
 623function TCodeGraph.GetTopologicalSortedList(out ListOfGraphNodes: TFPList;
 624  InEdgeDirection, SetTopologicalLvl, SortForStartPos: boolean): TCodeGraphEdge;
 625{ returns nil if there is no circle
 626  else: returns a circle edge
 627  ListOfTGraphNodes are all those GraphNodes, that could be sorted topologically
 628  if InEdgeDirection=true then the list starts with the nodes without in-edges
 629  else the list start with the nodes without out-edges
 630  
 631  if SetTopologicalLvl=true then the GraphNode.Flags will be set to the
 632    topological level, starting at 0 for nodes with no in edges.
 633  
 634  if SortForStartPos=true the nodes will be sorted for Node.StartPos
 635    as secondary order, keeping the topologically order
 636}
 637var
 638  NodeQueue: array of TCodeGraphNode;
 639  QueueStart: Integer;
 640  QueueEnd: Integer;
 641  
 642  procedure AddNode(GraphNode: TCodeGraphNode);
 643  begin
 644    //DebugLn(['AddNode ',GraphNode.Node.DescAsString]);
 645    NodeQueue[QueueEnd]:=GraphNode;
 646    inc(QueueEnd);
 647  end;
 648  
 649var
 650  AVLNode: TAVLTreeNode;
 651  GraphNode: TCodeGraphNode;
 652  GraphEdge: TCodeGraphEdge;
 653  CurGraphNode: TCodeGraphNode;
 654  EdgeAVLNode: TAVLTreeNode;
 655  i: Integer;
 656  CurTree: TAVLTree;
 657  SortedNodes: TAVLTree;
 658begin
 659  //DebugLn(['TCodeGraph.GetTopologicalSortedList START']);
 660  Result:=nil;
 661  ListOfGraphNodes:=TFPList.Create;
 662  if (Nodes=nil) or (Nodes.Count=0) then exit;
 663  ListOfGraphNodes.Capacity:=Nodes.Count;
 664
 665  try
 666    // init queue
 667    SetLength(NodeQueue,Nodes.Count);
 668    QueueStart:=0;
 669    QueueEnd:=0;
 670    // add all nodes without incoming edges and set all FInternalFlags to
 671    // the number of incoming nodes
 672    AVLNode:=Nodes.FindLowest;
 673    while AVLNode<>nil do begin
 674      GraphNode:=TCodeGraphNode(AVLNode.Data);
 675      if InEdgeDirection then
 676        CurTree:=GraphNode.InTree
 677      else
 678        CurTree:=GraphNode.OutTree;
 679      if (CurTree=nil) or (CurTree.Count=0) then begin
 680        GraphNode.FInternalFlags:=0;
 681        AddNode(GraphNode);
 682      end else begin
 683        GraphNode.FInternalFlags:=CurTree.Count;
 684      end;
 685      AVLNode:=Nodes.FindSuccessor(AVLNode);
 686    end;
 687    
 688    // add all nodes without incoming edges from the queue into the list
 689    while QueueStart<>QueueEnd do begin
 690      GraphNode:=NodeQueue[QueueStart];
 691      inc(QueueStart);
 692      ListOfGraphNodes.Add(GraphNode);
 693      // update the FInternalFlags counter
 694      if InEdgeDirection then
 695        CurTree:=GraphNode.OutTree
 696      else
 697        CurTree:=GraphNode.InTree;
 698      if (CurTree<>nil) then begin
 699        EdgeAVLNode:=CurTree.FindLowest;
 700        while EdgeAVLNode<>nil do begin
 701          GraphEdge:=TCodeGraphEdge(EdgeAVLNode.Data);
 702          if InEdgeDirection then
 703            CurGraphNode:=GraphEdge.ToNode
 704          else
 705            CurGraphNode:=GraphEdge.FromNode;
 706          dec(CurGraphNode.FInternalFlags);
 707          if CurGraphNode.FInternalFlags=0 then
 708            // a new node has no incoming edges => add to the queue
 709            AddNode(CurGraphNode);
 710          EdgeAVLNode:=CurTree.FindSuccessor(EdgeAVLNode);
 711        end;
 712      end;
 713    end;
 714    
 715    if ListOfGraphNodes.Count<Nodes.Count then begin
 716      // there is a circle
 717      // find a node of a circle
 718      AVLNode:=Nodes.FindLowest;
 719      while (AVLNode<>nil) and (Result=nil) do begin
 720        GraphNode:=TCodeGraphNode(AVLNode.Data);
 721        if InEdgeDirection then
 722          CurTree:=GraphNode.OutTree
 723        else
 724          CurTree:=GraphNode.InTree;
 725        if (GraphNode.FInternalFlags>0) and (CurTree<>nil) and (CurTree.Count>0)
 726        then begin
 727          // find an edge of a circle
 728          EdgeAVLNode:=CurTree.FindLowest;
 729          while EdgeAVLNode<>nil do begin
 730            GraphEdge:=TCodeGraphEdge(EdgeAVLNode.Data);
 731            if (InEdgeDirection and (GraphEdge.ToNode.OutTreeCount>0))
 732            or ((not InEdgeDirection) and (GraphEdge.FromNode.InTreeCount>0))
 733            then begin
 734              Result:=GraphEdge;
 735              break;
 736            end;
 737            EdgeAVLNode:=CurTree.FindSuccessor(EdgeAVLNode);
 738          end;
 739        end;
 740        AVLNode:=Nodes.FindSuccessor(AVLNode);
 741      end;
 742    end;
 743
 744    if (ListOfGraphNodes.Count>=1) then begin
 745      if SortForStartPos or SetTopologicalLvl then begin
 746        // calculate the topological levels
 747        if SortForStartPos then
 748          SortedNodes:=TAVLTree.Create(@CompareGraphNodesForTopoLvlAndStartPos)
 749        else
 750          SortedNodes:=nil;
 751        ClearInternalNodeFlags;
 752        for i:=0 to ListOfGraphNodes.Count-1 do begin
 753          GraphNode:=TCodeGraphNode(ListOfGraphNodes[i]);
 754          // find the maximum incoming topological level
 755          GraphNode.FInternalFlags:=0;
 756          if InEdgeDirection then
 757            CurTree:=GraphNode.InTree
 758          else
 759            CurTree:=GraphNode.OutTree;
 760          if (CurTree<>nil) then begin
 761            EdgeAVLNode:=CurTree.FindLowest;
 762            while EdgeAVLNode<>nil do begin
 763              GraphEdge:=TCodeGraphEdge(EdgeAVLNode.Data);
 764              if InEdgeDirection then
 765                CurGraphNode:=GraphEdge.FromNode
 766              else
 767                CurGraphNode:=GraphEdge.ToNode;
 768              if GraphNode.FInternalFlags<=CurGraphNode.FInternalFlags then
 769                // set the level to one higher than the maximum
 770                GraphNode.FInternalFlags:=CurGraphNode.FInternalFlags+1;
 771              EdgeAVLNode:=CurTree.FindSuccessor(EdgeAVLNode);
 772            end;
 773          end;
 774          // now level of this node is complete
 775          if SetTopologicalLvl then
 776            GraphNode.Flags:=GraphNode.FInternalFlags;
 777          if SortForStartPos then
 778            SortedNodes.Add(GraphNode);
 779        end;
 780        if SortForStartPos then begin
 781          // rebuild list with sorted nodes
 782          ListOfGraphNodes.Clear;
 783          AVLNode:=SortedNodes.FindLowest;
 784          while AVLNode<>nil do begin
 785            ListOfGraphNodes.Add(AVLNode.Data);
 786            AVLNode:=SortedNodes.FindSuccessor(AVLNode);
 787          end;
 788          SortedNodes.Free;
 789        end;
 790      end;
 791    end;
 792  finally
 793    SetLength(NodeQueue,0);
 794  end;
 795  //DebugLn(['TCodeGraph.GetTopologicalSortedList END']);
 796end;
 797
 798procedure TCodeGraph.GetMaximumCircle(StartNode: TCodeGraphNode; out
 799  ListOfGraphNodes: TFPList);
 800
 801  procedure AddNode(ANode: TCodeGraphNode);
 802  begin
 803    ANode.FInternalFlags:=2;
 804    ListOfGraphNodes.Add(ANode);
 805  end;
 806  
 807  procedure MarkReachableNodes(Node: TCodeGraphNode);
 808  var
 809    AVLNode: TAVLTreeNode;
 810    Edge: TCodeGraphEdge;
 811  begin
 812    Node.FInternalFlags:=1;
 813    if Node.OutTree=nil then exit;
 814    AVLNode:=Node.OutTree.FindLowest;
 815    while AVLNode<>nil do begin
 816      Edge:=TCodeGraphEdge(AVLNode.Data);
 817      if Edge.ToNode.FInternalFlags=0 then
 818        MarkReachableNodes(Edge.ToNode);
 819      AVLNode:=Node.OutTree.FindSuccessor(AVLNode);
 820    end;
 821  end;
 822  
 823  procedure AddCircleNodes(Node: TCodeGraphNode);
 824  var
 825    AVLNode: TAVLTreeNode;
 826    Edge: TCodeGraphEdge;
 827  begin
 828    AddNode(Node);
 829    if Node.InTree=nil then exit;
 830    AVLNode:=Node.InTree.FindLowest;
 831    while AVLNode<>nil do begin
 832      Edge:=TCodeGraphEdge(AVLNode.Data);
 833      if Edge.FromNode.FInternalFlags=1 then
 834        AddCircleNodes(Edge.FromNode);
 835      AVLNode:=Node.InTree.FindSuccessor(AVLNode);
 836    end;
 837  end;
 838  
 839begin
 840  ListOfGraphNodes:=TFPList.Create;
 841  ClearNodeFlags;
 842  MarkReachableNodes(StartNode);
 843  AddCircleNodes(StartNode);
 844end;
 845
 846function TCodeGraph.GetEdge(FromNode, ToNode: TCodeTreeNode;
 847  CreateIfNotExists: boolean): TCodeGraphEdge;
 848var
 849  ToGraphNode: TCodeGraphNode;
 850  FromGraphNode: TCodeGraphNode;
 851  AVLNode: TAVLTreeNode;
 852begin
 853  Result:=nil;
 854  AVLNode:=FindAVLNodeOfEdge(FromNode,ToNode);
 855  if AVLNode<>nil then begin
 856    Result:=TCodeGraphEdge(AVLNode.Data);
 857  end else begin
 858    if not CreateIfNotExists then exit;
 859    FromGraphNode:=GetGraphNode(FromNode,true);
 860    ToGraphNode:=GetGraphNode(ToNode,true);
 861    Result:=FEdgeClass.Create;
 862    Result.ToNode:=ToGraphNode;
 863    Result.FromNode:=FromGraphNode;
 864    Edges.Add(Result);
 865    if FromGraphNode.OutTree=nil then
 866      FromGraphNode.OutTree:=TAVLTree.Create(@CompareGraphEdgeByToNode);
 867    FromGraphNode.OutTree.Add(Result);
 868    if ToGraphNode.InTree=nil then
 869      ToGraphNode.InTree:=TAVLTree.Create(@CompareGraphEdgeByFromNode);
 870    ToGraphNode.InTree.Add(Result);
 871  end;
 872end;
 873
 874function TCodeGraph.FindAVLNodeOfNode(Node: TCodeTreeNode): TAVLTreeNode;
 875begin
 876  Result:=Nodes.FindKey(Node,@CompareNodeWithGraphNodeNode);
 877end;
 878
 879function TCodeGraph.FindAVLNodeOfToNode(InTree: TAVLTree; ToNode: TCodeTreeNode
 880  ): TAVLTreeNode;
 881begin
 882  if InTree<>nil then
 883    Result:=InTree.FindKey(ToNode,@CompareNodeWithGraphEdgeToNode)
 884  else
 885    Result:=nil;
 886end;
 887
 888function TCodeGraph.FindAVLNodeOfFromNode(OutTree: TAVLTree;
 889  FromNode: TCodeTreeNode): TAVLTreeNode;
 890begin
 891  if OutTree<>nil then
 892    Result:=OutTree.FindKey(FromNode,@CompareNodeWithGraphEdgeFromNode)
 893  else
 894    Result:=nil;
 895end;
 896
 897function TCodeGraph.FindAVLNodeOfEdge(FromNode, ToNode: TCodeTreeNode
 898  ): TAVLTreeNode;
 899var
 900  EdgeKey: TCodeGraphEdgeKey;
 901begin
 902  EdgeKey.FromNode:=FromNode;
 903  EdgeKey.ToNode:=ToNode;
 904  Result:=Edges.FindKey(@EdgeKey,@CompareEdgeKeyWithGraphEdge);
 905end;
 906
 907procedure TCodeGraph.ConsistencyCheck;
 908
 909  procedure e(const Msg: string);
 910  begin
 911    raise Exception.Create('TCodeGraph.ConsistencyCheck '+Msg);
 912  end;
 913
 914var
 915  AVLNode: TAVLTreeNode;
 916  GraphNode: TCodeGraphNode;
 917  EdgeAVLNode: TAVLTreeNode;
 918  Edge: TCodeGraphEdge;
 919begin
 920  if Nodes=nil then
 921    e('');
 922  if Edges=nil then
 923    e('');
 924  if Nodes.ConsistencyCheck<>0 then
 925    e('');
 926  if Edges.ConsistencyCheck<>0 then
 927    e('');
 928  if AVLTreeHasDoubles(Nodes)<>nil then
 929    e('');
 930  if AVLTreeHasDoubles(Edges)<>nil then
 931    e('');
 932
 933  AVLNode:=Nodes.FindLowest;
 934  while AVLNode<>nil do begin
 935    GraphNode:=TCodeGraphNode(AVLNode.Data);
 936    if GraphNode.InTree<>nil then begin
 937      if GraphNode.InTree.ConsistencyCheck<>0 then
 938        e('');
 939      if AVLTreeHasDoubles(GraphNode.InTree)<>nil then
 940        e('');
 941      EdgeAVLNode:=GraphNode.InTree.FindLowest;
 942      while EdgeAVLNode<>nil do begin
 943        Edge:=TCodeGraphEdge(EdgeAVLNode.Data);
 944        if Edges.Find(Edge)=nil then
 945          e('');
 946        if Edge.ToNode<>GraphNode then
 947          e('');
 948        EdgeAVLNode:=GraphNode.InTree.FindSuccessor(EdgeAVLNode);
 949      end;
 950    end;
 951    if GraphNode.OutTree<>nil then begin
 952      if GraphNode.OutTree.ConsistencyCheck<>0 then
 953        e('');
 954      if AVLTreeHasDoubles(GraphNode.OutTree)<>nil then
 955        e('');
 956      EdgeAVLNode:=GraphNode.OutTree.FindLowest;
 957      while EdgeAVLNode<>nil do begin
 958        Edge:=TCodeGraphEdge(EdgeAVLNode.Data);
 959        if Edges.Find(Edge)=nil then
 960          e('');
 961        if Edge.FromNode<>GraphNode then
 962          e('');
 963        EdgeAVLNode:=GraphNode.OutTree.FindSuccessor(EdgeAVLNode);
 964      end;
 965    end;
 966    AVLNode:=Nodes.FindSuccessor(AVLNode);
 967  end;
 968  
 969  AVLNode:=Edges.FindLowest;
 970  while AVLNode<>nil do begin
 971    Edge:=TCodeGraphEdge(AVLNode.Data);
 972    if Nodes.Find(Edge.FromNode)=nil then
 973      e('');
 974    if Nodes.Find(Edge.ToNode)=nil then
 975      e('');
 976    if Edge.FromNode.OutTree.Find(Edge)=nil then
 977      e('');
 978    if Edge.ToNode.InTree.Find(Edge)=nil then
 979      e('');
 980    AVLNode:=Edges.FindSuccessor(AVLNode);
 981  end;
 982end;
 983
 984{ TCodeGraphNode }
 985
 986function TCodeGraphNode.OutTreeCount: integer;
 987begin
 988  if OutTree<>nil then
 989    Result:=OutTree.Count
 990  else
 991    Result:=0;
 992end;
 993
 994function TCodeGraphNode.InTreeCount: integer;
 995begin
 996  if InTree<>nil then
 997    Result:=InTree.Count
 998  else
 999    Result:=0;
1000end;
1001
1002end.
1003