PageRenderTime 19ms CodeModel.GetById 10ms app.highlight 4ms RepoModel.GetById 1ms app.codeStats 0ms

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