ezdsllst.pas

Eazy Data Structures library for Delphi.

{===EZDSLLST==========================================================

Part of the Delphi Structures Library--the single linked list.

EZDSLLST is Copyright (c) 1993-2002 by  Julian M. Bucknall

VERSION HISTORY
12Feb02 JMB 3.03 Release for Delphi 6
24Oct99 JMB 3.02 Release for Delphi 4 & 5
19Apr98 JMB 3.00 Major new version, release for Delphi 3
24May96 JMB 2.01 improvements to Clone
13Mar96 JMB 2.00 release for Delphi 2.0
12Nov95 JMB 1.01 fixed Iterate bug
18Jun95 JMB 1.00 conversion of EZStrucs to Delphi
=====================================================================}
{ Copyright (c) 1993-2002, Julian M. Bucknall. All Rights Reserved   }

unit EzdsLLst;

{$I EzdslDef.inc}
{---Place any compiler options you require here----------------------}


{--------------------------------------------------------------------}
{$I EzdslOpt.inc}

interface

uses
  SysUtils,
  {$IFDEF Windows}
  WinTypes,
  WinProcs,
  {$ENDIF}
  {$IFDEF Win32}
  Windows,
  {$ENDIF}
  {$IFDEF Linux}
  Types,
  Libc,
  {$ENDIF}
  Classes,
  {$IFDEF ThreadsExist}
  EzdslThd,
  {$ENDIF}
  EzdslCts,
  EzdslSup,
  EzdslBse;

type
  TLinkList = class(TAbstractContainer)
    {-Single linked list object}
    private
      llCursor, llBF, llAL  : PNode;
    protected
      procedure acSort; override;

      procedure llNextN(N : longint);
      procedure llPrevN(N : longint);
      procedure llInsertBeforePrim(aData : pointer);
      function llMergeLists(aBeforeNode1 : PNode; aCount1 : longint;
                            aBeforeNode2 : PNode; aCount2 : longint) : PNode;
      function llMergeSort(aBeforeNode : PNode; aCount : longint) : PNode;
    public
      constructor Create(DataOwner : boolean); override;
      constructor Clone(Source : TAbstractContainer;
                        DataOwner : boolean; NewCompare : TCompareFunc); override;

      procedure Delete;
      procedure Empty; override;
      procedure Erase;
      function Examine : pointer;
      procedure InsertAfter(aData : pointer);
      procedure InsertBefore(aData : pointer);
      procedure InsertSorted(aData : pointer);
      function IsAfterLast : boolean;
      function IsBeforeFirst : boolean;
      function Iterate(Action : TIterator; Backwards : boolean;
                        ExtraData : pointer) : pointer;
      procedure Join(List : TLinkList);
      procedure Next;
      procedure Prev;
      function Replace(aData : pointer) : pointer;
      function Search(aData : pointer) : boolean;
      procedure SetBeforeFirst;
      procedure SetAfterLast;
      function Split : TLinkList;
  end;

{$IFDEF ThreadsExist}
type
  TThreadsafeLinkList = class
    protected {private}
      llLinkList : TLinkList;
      llResLock  : TezResourceLock;
    protected
    public
      constructor Create(aDataOwner : boolean);
      destructor Destroy; override;

      function AcquireAccess : TLinkList;
      procedure ReleaseAccess;
  end;
{$ENDIF}

implementation

{-An iterator for cloning a single linked list}
function SListCloneItem(SL : TAbstractContainer;
                        aData : pointer;
                        NSL : pointer) : boolean; far;
var
  NewList : TLinkList absolute NSL;
  NewData : pointer;
begin
  {Note: assumes that NewList.IsAfterLast is true}
  Result := true;
  with NewList do begin
    if IsDataOwner then
      NewData := DupData(aData)
    else
      NewData := aData;
    try
      InsertBefore(NewData);
    except
      if IsDataOwner and Assigned(NewData) then
        DisposeData(NewData);
      raise;
    end;{try..except}
  end;
end;

{-An iterator for cloning a SORTED single linked list}
function SListSortedCloneItem(SL : TAbstractContainer;
                              aData : pointer;
                              NSL : pointer) : boolean; far;
var
  NewList : TLinkList absolute NSL;
  NewData : pointer;
begin
  Result := true;
  with NewList do begin
    if IsDataOwner then
      NewData := DupData(aData)
    else
      NewData := aData;
    try
      InsertSorted(NewData);
    except
      if IsDataOwner and Assigned(NewData) then
        DisposeData(NewData);
      raise;
    end;{try..except}
  end;
end;

{====================================================================}


{===TLinkList========================================================}
constructor TLinkList.Create(DataOwner : boolean);
begin
  acNodeSize := 8;
  inherited Create(DataOwner);
  llBF := acNewNode(nil);
  acCount := 0;
  llAL := acNewNode(nil);
  acCount := 0;
  llBF^.Link := llAL;
  llAL^.Link := nil;
  llCursor := llBF;
  acCanChangeSorted := true;
end;
{--------}
constructor TLinkList.Clone(Source : TAbstractContainer;
                            DataOwner : boolean;
                            NewCompare : TCompareFunc);
var
  OldList : TLinkList absolute Source;
begin
  if not (Source is TLinkList) then
    RaiseError(escBadSource);

  Create(DataOwner);
  if Assigned(NewCompare) then
    Compare := NewCompare
  else
    Compare := OldList.Compare;
  DupData := OldList.DupData;
  DisposeData := OldList.DisposeData;
  IsSorted := OldList.IsSorted;

  if OldList.IsEmpty then Exit;

  SetAfterLast;
  if IsSorted then
    OldList.Iterate(SListSortedCloneItem, false, Self)
  else
    OldList.Iterate(SListCloneItem, false, Self);
end;
{--------}
procedure TLinkList.acSort;
begin
  if IsSorted then begin
    {move to the start, ie, make it a proper singly linked list}
    SetBeforeFirst;
    {now mergesort the linked list}
    llMergeSort(llBF, Count);
  end;
end;
{--------}
procedure TLinkList.Delete;
var
  Temp : PNode;
begin
  {$IFDEF DEBUG}
  EZAssert((not IsBeforeFirst) and (not IsAfterLast), ascDeleteEdges);
  {$ENDIF}
  Temp := llCursor^.Link;
  acDisposeNode(llCursor);
  llCursor := llBF^.Link;
  llBF^.Link := llCursor^.Link;
  llCursor^.Link := Temp;
end;
{--------}
procedure TLinkList.Empty;
begin
  if not IsEmpty then begin
    if IsBeforeFirst then
      Next;
    while not IsAfterLast do
      Erase;
    while not IsEmpty do begin
      Prev;
      Erase;
    end;
  end;
  if acInDone then begin
    if Assigned(llBF) then
      acDisposeNode(llBF);
    if Assigned(llAL) then
      acDisposeNode(llAL);
  end
  else begin
    llBF^.Link := llAL;
    llAL^.Link := nil;
    llCursor := llBF;
  end;
end;
{--------}
procedure TLinkList.Erase;
begin
  if IsDataOwner then
    DisposeData(Examine);
  Delete;
end;
{--------}
function TLinkList.Examine : pointer;
begin
  {$IFDEF DEBUG}
  EZAssert((not IsBeforeFirst) and (not IsAfterLast), ascExamineEdges);
  {$ENDIF}
  Result := llCursor^.Data;
end;
{--------}
procedure TLinkList.InsertAfter(aData : pointer);
var
  Node : PNode;
begin
  {$IFDEF DEBUG}
  EZAssert(not IsSorted, ascIsSortedList);
  EZAssert(not IsAfterLast, ascInsertEdges);
  {$ENDIF}
  Node := acNewNode(aData);
  Node^.Link := llBF^.Link;
  llBF^.Link := Node;
end;
{--------}
procedure TLinkList.InsertBefore(aData : pointer);
begin
  {$IFDEF DEBUG}
  EZAssert(not IsSorted, ascIsSortedList);
  EZAssert(not IsBeforeFirst, ascInsertEdges);
  {$ENDIF}
  llInsertBeforePrim(aData);
end;
{--------}
procedure TLinkList.InsertSorted(aData : pointer);
begin
  {$IFDEF DEBUG}
  EZAssert(IsSorted, ascIsNotSortedList);
  {$ENDIF}
  if Search(aData) then
    RaiseError(escInsertDup);
  llInsertBeforePrim(aData);
end;
{--------}
function TLinkList.IsAfterLast : boolean;
begin
  Result := (llCursor = llAL);
end;
{--------}
function TLinkList.IsBeforeFirst : boolean;
begin
  Result := (llCursor = llBF);
end;
{--------}
function TLinkList.Iterate(Action : TIterator; Backwards : boolean;
                            ExtraData : pointer) : pointer;
begin
  if Backwards then begin
    SetAfterLast;
    Prev;
    while not IsBeforeFirst do begin
      if Action(Self, Examine, ExtraData) then
        Prev
      else begin
        Result := Examine;
        Exit;
      end;
    end;
  end
  else {not Backwards} begin
    SetBeforeFirst;
    Next;
    while not IsAfterLast do begin
      if Action(Self, Examine, ExtraData) then
        Next
      else begin
        Result := Examine;
        Exit;
      end;
    end;
  end;
  Result := nil;
end;
{--------}
procedure TLinkList.Join(List : TLinkList);
var
  JoinNode : PNode;
  Data     : pointer;
begin
  if not Assigned(List) then Exit;

  {$IFDEF DEBUG}
  EZAssert(not IsAfterLast, ascCannotJoinHere);
  EZAssert(List.IsDataOwner = IsDataOwner, ascCannotJoinData);
  {$ENDIF}

  if not List.IsEmpty then begin
    {prepare}
     with List do begin
       SetBeforeFirst;
       Next;
     end;
    {if we are sorted, add new nodes in sorted order}
    if {Self.}IsSorted then
      while not List.IsAfterLast do begin
        Data := List.Examine;
        List.Delete;
        InsertSorted(Data);
      end
    {if we are not sorted, add new nodes directly}
    else {Self is unsorted} begin
      JoinNode := List.llCursor;
      with List do begin
        SetAfterLast;
        Prev;
      end;
      JoinNode^.Link := llCursor;
      llCursor := List.llCursor;
      inc(acCount, List.Count);
      {patch up List to be empty}
      with List do begin