/components/jcf2/Process/TreeWalker.pas

http://github.com/graemeg/lazarus · Pascal · 161 lines · 74 code · 26 blank · 61 comment · 8 complexity · 28f65757ea479ee893dc40c0c1c8d7a8 MD5 · raw file

  1. unit TreeWalker;
  2. {(*}
  3. (*------------------------------------------------------------------------------
  4. Delphi Code formatter source code
  5. The Original Code is SimpleTreeWalker, released March 2004.
  6. The Initial Developer of the Original Code is Anthony Steele.
  7. Portions created by Anthony Steele are Copyright (C) 1999-2008 Anthony Steele.
  8. All Rights Reserved.
  9. Contributor(s):
  10. Anthony Steele.
  11. The contents of this file are subject to the Mozilla Public License Version 1.1
  12. (the "License"). you may not use this file except in compliance with the License.
  13. You may obtain a copy of the License at http://www.mozilla.org/NPL/
  14. Software distributed under the License is distributed on an "AS IS" basis,
  15. WITHOUT WARRANTY OF ANY KIND, either express or implied.
  16. See the License for the specific language governing rights and limitations
  17. under the License.
  18. Alternatively, the contents of this file may be used under the terms of
  19. the GNU General Public License Version 2 or later (the "GPL")
  20. See http://www.gnu.org/licenses/gpl.html
  21. ------------------------------------------------------------------------------*)
  22. {*)}
  23. {$I JcfGlobal.inc}
  24. interface
  25. { AFS 1 March 04
  26. Simpler, hopefully faster approach to visiting the tree
  27. Code is in neither the visitor or the tree
  28. but uses both
  29. The tree is a root node with children
  30. The visitor is a process which is applied to each node in turn
  31. This is how all processes that transform the program input to output
  32. are applied. So it is key to the second phase of the program,
  33. The first being generating the parse tree
  34. }
  35. uses ParseTreeNode, BaseVisitor;
  36. type
  37. TTreeWalker = class(TObject)
  38. private
  39. { flags about the current visitor's needs
  40. Almost all visitors use the infix walk of leaf nodes
  41. Few look at the interior nodes }
  42. { does it do the prefix walk of interior nodes? }
  43. fbHasPreVisit: Boolean;
  44. { does it do the postfix walk of interior nodes? }
  45. fbHasPostVisit: Boolean;
  46. { does it visit the leaves - almost all do }
  47. fbHasSourceTokenVisit: Boolean;
  48. { flag set true when a a visitor request that the current item be deleted,
  49. and the index is thereafter wrong }
  50. fbRecalcIndex: Boolean;
  51. fcVisitor: TBaseTreeNodeVisitor;
  52. procedure InitialiseFlags;
  53. procedure VisitTree(const pcNode: TParseTreeNode);
  54. public
  55. procedure Visit(const pcRoot: TParseTreeNode; const pcVisitor: TBaseTreeNodeVisitor);
  56. end;
  57. implementation
  58. uses
  59. { delphi } SysUtils;
  60. procedure TTreeWalker.InitialiseFlags;
  61. begin
  62. { read these once only for speed }
  63. fbHasPreVisit := fcVisitor.HasPreVisit;
  64. fbHasPostVisit := fcVisitor.HasPostVisit;
  65. fbHasSourceTokenVisit := fcVisitor.HasSourceTokenVisit;
  66. end;
  67. procedure TTreeWalker.VisitTree(const pcNode: TParseTreeNode);
  68. const
  69. { if a node has more than this number of direct children, then something is very wrong
  70. can have lots in some "header" units that just list a lot of consts
  71. AFS 8 Oct 2006 upped it for Sourceforge bug 1558885 }
  72. MAX_NODE_CHILDREN = 4194304;
  73. var
  74. liLoop: Integer;
  75. lcChildNode: TParseTreeNode;
  76. liNewIndex: Integer;
  77. begin
  78. if pcNode.IsLeaf then
  79. begin
  80. if fbHasSourceTokenVisit then
  81. fbRecalcIndex := fcVisitor.VisitSourceToken(pcNode);
  82. end
  83. else
  84. begin
  85. { not leaf - visit children }
  86. if fbHasPreVisit then
  87. fcVisitor.PreVisitParseTreeNode(pcNode);
  88. if pcNode.ChildNodeCount > MAX_NODE_CHILDREN then
  89. begin
  90. // some parse or insert process has gone bezerk
  91. raise Exception.Create('Too many child nodes ' + IntToStr(pcNode.ChildNodeCount));
  92. end;
  93. liLoop := 0;
  94. while liLoop < pcNode.ChildNodeCount do
  95. begin
  96. lcChildNode := pcNode.ChildNodes[liLoop];
  97. VisitTree(lcChildNode);
  98. { fbRecalcIndex flag is for speed
  99. need to deal with shifting indexes when an item is moved or deleted
  100. but only then. The rest of the time it just slows us down }
  101. if fbRecalcIndex then
  102. begin
  103. { has this node been moved or removed?
  104. if so, don't increment counter, as the next item will now be in this slot }
  105. liNewIndex := pcNode.IndexOfChild(lcChildNode);
  106. fbRecalcIndex := False;
  107. if liNewIndex >= 0 then
  108. // proceed to next one
  109. liLoop := liNewIndex + 1;
  110. { else case is that liNewIndex is -1 as the current item has been deleted.
  111. Stay at same index as the next item will now be in this slot }
  112. end
  113. else
  114. inc(liLoop);
  115. end;
  116. if fbHasPostVisit then
  117. fcVisitor.PostVisitParseTreeNode(pcNode);
  118. end;
  119. end;
  120. procedure TTreeWalker.Visit(const pcRoot: TParseTreeNode; const pcVisitor: TBaseTreeNodeVisitor);
  121. begin
  122. Assert(pcRoot <> nil);
  123. Assert(pcVisitor <> nil);
  124. fcVisitor := pcVisitor;
  125. InitialiseFlags;
  126. VisitTree(pcRoot);
  127. end;
  128. end.