diff --git a/components/codetools/codetoolsstructs.pas b/components/codetools/codetoolsstructs.pas index fdcdef7cad..789b860a3f 100644 --- a/components/codetools/codetoolsstructs.pas +++ b/components/codetools/codetoolsstructs.pas @@ -81,6 +81,80 @@ type destructor Destroy; override; end; + { TGenericAVLTreeEnumerator } + + generic TGenericAVLTreeEnumerator = class + private + FTree: TAVLTree; + FCurrent: TAVLTreeNode; + function GetCurrent: TData; + public + constructor Create(Tree: TAVLTree); + function MoveNext: boolean; + property Current: TData read GetCurrent; + end; + + { TBaseStringMap } + + TBaseStringMap = class + private + type + TBaseStringMapItem = record + Name: string; + end; + PBaseStringMapItem = ^TBaseStringMapItem; + private + FCompareKeyItemFunc: TListSortCompare; + FTree: TMTAVLTree;// tree of PGenericStringMapItem + FCaseSensitive: boolean; + function GetCompareItemsFunc: TListSortCompare; + function FindNode(const s: string): TAVLTreeNode; + procedure DisposeItem(NodeData: Pointer); virtual; abstract; + function IsDataEqual(NodeData1, NodeData2: Pointer): boolean; virtual; abstract; + public + constructor Create(TheCaseSensitive: boolean); + destructor Destroy; override; + procedure Clear; + function Contains(const s: string): boolean; + function ContainsIdentifier(P: PChar): boolean; + function FindNodeWithIdentifierAsPrefix(P: PChar): TAVLTreeNode; + procedure GetNames(List: TStrings); + procedure Remove(const Name: string); + property CaseSensitive: boolean read FCaseSensitive; + property Tree: TMTAVLTree read FTree; // tree of PGenericStringMapItem + function Equals(OtherTree: TBaseStringMap): boolean; reintroduce; + procedure WriteDebugReport; + function CalcMemSize: PtrUint; + property CompareItemsFunc: TListSortCompare read GetCompareItemsFunc; + property CompareKeyItemFunc: TListSortCompare read FCompareKeyItemFunc; + procedure SetCompareFuncs( + const NewCompareItemsFunc, NewCompareKeyItemFunc: TListSortCompare); + end; + + { TGenericStringMap } + + generic TGenericStringMap = class(TBaseStringMap) + public + type + TGenericStringMapItem = record + Name: string; + Value: TData; + end; + PGenericStringMapItem = ^TGenericStringMapItem; + TSpecStringMapEnumerator = specialize TGenericAVLTreeEnumerator; + private + function GetItems(const s: string): TData; + procedure SetItems(const s: string; const AValue: TData); + procedure DisposeItem(NodeData: Pointer); override; + function IsDataEqual(NodeData1, NodeData2: Pointer): boolean; override; + public + function Get(const Name: string; out Value: TData): boolean; + procedure Add(const Name: string; const Value: TData); + property Items[const s: string]: TData read GetItems write SetItems; default; + procedure Assign(Source: TGenericStringMap); + function GetEnumerator: TSpecStringMapEnumerator; + end; + TStringMap = class; TStringMapItem = record @@ -424,6 +498,29 @@ begin {$ENDIF} end; +{ TGenericAVLTreeEnumerator } + +function TGenericAVLTreeEnumerator.GetCurrent: TData; +begin + Result:=TData(FCurrent.Data); +end; + +constructor TGenericAVLTreeEnumerator.Create(Tree: TAVLTree); +begin + FTree:=Tree; +end; + +function TGenericAVLTreeEnumerator.MoveNext: boolean; +begin + if FCurrent=nil then + FCurrent:=FTree.FindLowest + else + FCurrent:=FTree.FindSuccessor(FCurrent); + Result:=FCurrent<>nil; +end; + +{ TMTAVLTree } + constructor TMTAVLTree.Create(OnCompareMethod: TListSortCompare); begin inherited Create(OnCompareMethod); @@ -449,6 +546,242 @@ begin Result:=TAVLTreeNode.Create; end; +{ TBaseStringMap } + +function TBaseStringMap.GetCompareItemsFunc: TListSortCompare; +begin + Result:=Tree.OnCompare; +end; + +function TBaseStringMap.FindNode(const s: string): TAVLTreeNode; +begin + Result:=FTree.FindKey(Pointer(s),FCompareKeyItemFunc) +end; + +constructor TBaseStringMap.Create(TheCaseSensitive: boolean); +begin + FCaseSensitive:=TheCaseSensitive; + if CaseSensitive then begin + FCompareKeyItemFunc:=@CompareStringAndStringToStringTreeItem; + FTree:=TMTAVLTree.Create(@CompareStringToStringItems); + end else begin + FCompareKeyItemFunc:=@CompareStringAndStringToStringTreeItemI; + FTree:=TMTAVLTree.Create(@CompareStringToStringItemsI); + end; +end; + +destructor TBaseStringMap.Destroy; +begin + Clear; + FTree.Free; + FTree:=nil; + inherited Destroy; +end; + +procedure TBaseStringMap.Clear; +var + Node: TAVLTreeNode; +begin + Node:=FTree.FindLowest; + while Node<>nil do begin + DisposeItem(Node.Data); + Node:=FTree.FindSuccessor(Node); + end; + FTree.Clear; +end; + +function TBaseStringMap.Contains(const s: string): boolean; +begin + Result:=FindNode(s)<>nil; +end; + +function TBaseStringMap.ContainsIdentifier(P: PChar): boolean; +begin + if CaseSensitive then + Result:=FTree.FindKey(p,@CompareIdentifierAndStringToStringTreeItem)<>nil + else + Result:=FTree.FindKey(p,@CompareIdentifierAndStringToStringTreeItemI)<>nil; +end; + +function TBaseStringMap.FindNodeWithIdentifierAsPrefix(P: PChar): TAVLTreeNode; +begin + if CaseSensitive then + Result:=FTree.FindKey(p,@CompareIdentifierPrefixAndStringToStringTreeItem) + else + Result:=FTree.FindKey(p,@CompareIdentifierPrefixAndStringToStringTreeItemI); +end; + +procedure TBaseStringMap.GetNames(List: TStrings); +var + Node: TAVLTreeNode; + Item: PBaseStringMapItem; +begin + Node:=Tree.FindLowest; + while Node<>nil do begin + Item:=PBaseStringMapItem(Node.Data); + List.Add(Item^.Name); + Node:=Tree.FindSuccessor(Node); + end; +end; + +procedure TBaseStringMap.Remove(const Name: string); +var + Node: TAVLTreeNode; + Item: Pointer; +begin + Node:=FindNode(Name); + if Node<>nil then begin + Item:=Node.Data; + FTree.Delete(Node); + DisposeItem(Item); + end; +end; + +function TBaseStringMap.Equals(OtherTree: TBaseStringMap): boolean; +var + Node: TAVLTreeNode; + OtherNode: TAVLTreeNode; + OtherItem: PBaseStringMapItem; + Item: PBaseStringMapItem; +begin + Result:=false; + if OtherTree=nil then exit; + if OtherTree.ClassType<>ClassType then exit; + if Tree.Count<>OtherTree.Tree.Count then exit; + Node:=Tree.FindLowest; + OtherNode:=OtherTree.Tree.FindLowest; + while Node<>nil do begin + if OtherNode=nil then exit; + Item:=PBaseStringMapItem(Node.Data); + OtherItem:=PBaseStringMapItem(OtherNode.Data); + if (Item^.Name<>OtherItem^.Name) + or (not IsDataEqual(Item,OtherItem)) then exit; + OtherNode:=OtherTree.Tree.FindSuccessor(OtherNode); + Node:=Tree.FindSuccessor(Node); + end; + if OtherNode<>nil then exit; + Result:=true; +end; + +procedure TBaseStringMap.WriteDebugReport; +var + Node: TAVLTreeNode; + Item: PStringToStringTreeItem; +begin + DebugLn(['TGenericStringMap.WriteDebugReport ',Tree.Count]); + Node:=Tree.FindLowest; + while Node<>nil do begin + Item:=PStringToStringTreeItem(Node.Data); + DebugLn([Item^.Name]); + Node:=Tree.FindSuccessor(Node); + end; +end; + +function TBaseStringMap.CalcMemSize: PtrUint; +var + Node: TAVLTreeNode; + Item: PBaseStringMapItem; +begin + Result:=PtrUInt(InstanceSize) + +PtrUInt(FTree.InstanceSize) + +PtrUint(FTree.Count)*SizeOf(TAVLTreeNode); + Node:=FTree.FindLowest; + while Node<>nil do begin + Item:=PBaseStringMapItem(Node.Data); + inc(Result,MemSizeString(Item^.Name) + +SizeOf(TBaseStringMapItem)); + Node:=FTree.FindSuccessor(Node); + end; +end; + +procedure TBaseStringMap.SetCompareFuncs(const NewCompareItemsFunc, + NewCompareKeyItemFunc: TListSortCompare); +begin + FCompareKeyItemFunc:=NewCompareKeyItemFunc; + Tree.OnCompare:=NewCompareItemsFunc; +end; + +{ TGenericStringMap } + +function TGenericStringMap.GetItems(const s: string): TData; +var + Node: TAVLTreeNode; +begin + Node:=FindNode(s); + if Node<>nil then + Result:=PGenericStringMapItem(Node.Data)^.Value + else + Result:='' +end; + +procedure TGenericStringMap.SetItems(const s: string; const AValue: TData); +var + Node: TAVLTreeNode; + NewItem: PStringToStringTreeItem; +begin + Node:=FindNode(s); + if Node<>nil then begin + PGenericStringMapItem(Node.Data)^.Value:=AValue; + end else begin + New(NewItem); + NewItem^.Name:=s; + NewItem^.Value:=AValue; + FTree.Add(NewItem); + end; +end; + +procedure TGenericStringMap.DisposeItem(NodeData: Pointer); +var + Item: PGenericStringMapItem absolute NodeData; +begin + DisposeItem(Item); +end; + +function TGenericStringMap.IsDataEqual(NodeData1, NodeData2: Pointer): boolean; +var + Item1: PGenericStringMapItem absolute NodeData1; + Item2: PGenericStringMapItem absolute NodeData2; +begin + Result:=Item1^.Value=Item2^.Value; +end; + +function TGenericStringMap.Get(const Name: string; out Value: TData): boolean; +var + Node: TAVLTreeNode; +begin + Node:=FindNode(Name); + if Node<>nil then begin + Value:=PGenericStringMapItem(Node.Data)^.Value; + Result:=true; + end else begin + Result:=false; + end; +end; + +procedure TGenericStringMap.Add(const Name: string; const Value: TData); +begin + Items[Name]:=Value; +end; + +procedure TGenericStringMap.Assign(Source: TGenericStringMap); +var + Node: TAVLTreeNode; + Item: PGenericStringMapItem; +begin + Clear; + Node:=Source.Tree.FindLowest; + while Node<>nil do begin + Item:=PGenericStringMapItem(Node.Data); + Items[Item^.Name]:=Item^.Value; + Node:=Source.Tree.FindSuccessor(Node); + end; +end; + +function TGenericStringMap.GetEnumerator: TSpecStringMapEnumerator; +begin + Result:=TSpecStringMapEnumerator.Create(Tree); +end; + { TFilenameToPointerTree } constructor TFilenameToPointerTree.Create(CaseInsensitive: boolean);