/components/codetools/codegraph.pas
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