utils/uutlListBase.pas

unit uutlListBase;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils,
  uutlArrayContainer, uutlInterfaces, uutlEnumerator;

type
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  generic TutlListBase<T> = class(
    specialize TutlArrayContainer<T>
    , specialize IEnumerable<T>
    , specialize IutlEnumerable<T>)

  public type
    IEnumerator = specialize IEnumerator<T>;
    IutlEnumerator = specialize IutlEnumerator<T>;

  private type
    TEnumeratorAction = (
      eaAdded,
      eaRemoved,
      eaReallocated
    );

    TEnumerator = class(
      specialize TutlMemoryEnumerator<T>
      , IEnumerator
      , IutlEnumerator)
    private
      fOwner: TutlListBase;
      fCurrentIsInvalid: Boolean;
      fNext: TEnumerator;
      fPrev: TEnumerator;

    public { IEnumerator }
      function  GetCurrent: T; override;
      function  InternalMoveNext: Boolean; override;
      procedure InternalReset; override;

    {$IFDEF UTL_ENUMERATORS}
    public { IutlEnumerator }
      function Reverse: IutlEnumerator; override;
    {$ENDIF}

    public
      procedure Update(const aIndex: Integer; const aAction: TEnumeratorAction);

      constructor Create(const aOwner: TutlListBase; const aReversed: Boolean); reintroduce;
      destructor Destroy; override;
    end;

  strict private
    fCount: Integer;
    fFirstEnumerator: TEnumerator;
    fLastEnumerator: TEnumerator;

    procedure UpdateEnumerator(const aIndex: Integer; const aAction: TEnumeratorAction);

  protected
    function  GetCount: Integer; override;
    procedure SetCount(const aValue: Integer); override;

    function  GetItem     (const aIndex: Integer): T; virtual;
    procedure SetItem     (const aIndex: Integer; aValue: T); virtual;
    procedure SetCapacity (const aValue: integer); override;

    procedure InsertIntern(const aIndex: Integer; constref aValue: T); virtual;
    procedure DeleteIntern(const aIndex: Integer; const aFreeItem: Boolean); virtual;

  public { IEnumerable }
    function GetEnumerator: IEnumerator;

  public { IutlEnumerable }
    function GetUtlEnumerator: IutlEnumerator;

  public
    property Count;
    property IsEmpty;
    property Capacity;
    property CanShrink;
    property CanExpand;
    property OwnsItems;

    procedure Clear; virtual;
    procedure ShrinkToFit;

    constructor Create(const aOwnsItems: Boolean);
    destructor Destroy; override;
  end;

implementation

uses
  uutlCommon;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlListBase.TEnumerator//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlListBase.TEnumerator.GetCurrent: T;
begin
  if fCurrentIsInvalid then
    raise EInvalidOperation.Create('current item was deleted, move on with ''MoveNext'' before accessing ''Current''');
  result := inherited GetCurrent;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlListBase.TEnumerator.InternalMoveNext: Boolean;
begin
  result := inherited InternalMoveNext;
  fCurrentIsInvalid := false;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlListBase.TEnumerator.InternalReset;
begin
  First  := 0;
  Last   := fOwner.Count-1;
  if (Last >= First)
    then Memory := fOwner.GetInternalItem(0)
    else Memory := nil;
  inherited InternalReset;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
{$IFDEF UTL_ENUMERATORS}
function TutlListBase.TEnumerator.Reverse: IutlEnumerator;
begin
  result := TEnumerator.Create(fOwner, not Reversed);
end;
{$ENDIF}

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlListBase.TEnumerator.Update(const aIndex: Integer; const aAction: TEnumeratorAction);
begin
  case aAction of
    eaAdded: begin
      if (aIndex <= Current) then
        Current := Current + 1;
      Last := Last + 1;
    end;

    eaRemoved: begin
      fCurrentIsInvalid := (aIndex = Current);
      if     (aIndex < Current)
          or (   (aIndex = Current)
              and not Reversed)
      then
        Current := Current - 1;
      Last := Last - 1;
    end;

    eaReallocated: begin
      if (fOwner.Count > 0)
        then Memory := fOwner.GetInternalItem(0)
        else Memory := nil;
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlListBase.TEnumerator.Create(const aOwner: TutlListBase; const aReversed: Boolean);
begin
  if not Assigned(aOwner) then
    raise EArgumentNilException.Create('aOwner');
  fOwner := aOwner;
  if not Assigned(fOwner.fLastEnumerator) then begin
    fPrev := nil;
    fNext := nil;
    fOwner.fFirstEnumerator := self;
    fOwner.fLastEnumerator  := self;
  end else begin
    fPrev := fOwner.fLastEnumerator;
    fNext := nil;
    fOwner.fLastEnumerator.fNext := self;
    fOwner.fLastEnumerator       := self;
  end;
  inherited Create(nil, aReversed, 0, -1);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
destructor TutlListBase.TEnumerator.Destroy;
begin
  if (fOwner.fFirstEnumerator = self) then
    fOwner.fFirstEnumerator := fNext;
  if (fOwner.fLastEnumerator = self) then
    fOwner.fLastEnumerator := fPrev;
  if Assigned(fPrev) then
    fPrev.fNext := fNext;
  if Assigned(fNext) then
    fNext.fPrev := fPrev;
  inherited Destroy;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlListBase//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlListBase.UpdateEnumerator(const aIndex: Integer; const aAction: TEnumeratorAction);
var
  e: TEnumerator;
begin
  e := fFirstEnumerator;
  while Assigned(e) do begin
    e.Update(aIndex, aAction);
    e := e.fNext;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlListBase.GetCount: Integer;
begin
  result := fCount;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlListBase.SetCount(const aValue: Integer);
begin
  if (aValue > Capacity) then
    Capacity := aValue;
  fCount := aValue;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlListBase.GetItem(const aIndex: Integer): T;
begin
  if (aIndex < 0) or (aIndex >= Count) then
    raise EOutOfRangeException.Create(aIndex, 0, Count-1);
  result := GetInternalItem(aIndex)^;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlListBase.SetItem(const aIndex: Integer; aValue: T);
var
  p: PT;
begin
  if (aIndex < 0) or (aIndex >= Count) then
    raise EOutOfRangeException.Create(aIndex, 0, Count-1);
  p := GetInternalItem(aIndex);
  Release(p^, true);
  p^ := aValue;
end;

procedure TutlListBase.SetCapacity(const aValue: integer);
begin
  inherited SetCapacity(aValue);
  UpdateEnumerator(0, eaReallocated);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlListBase.InsertIntern(const aIndex: Integer; constref aValue: T);
var
  p: PT;
begin
  if (aIndex < 0) or (aIndex > fCount) then
    raise EOutOfRangeException.Create(aIndex, 0, fCount);
  if (fCount = Capacity) then
    Expand;
  p := GetInternalItem(aIndex);
  if (aIndex < fCount) then
    System.Move(p^, (p+1)^, (fCount - aIndex) * SizeOf(T));
  FillByte(p^, SizeOf(T), 0); // zero new item (to suppress _release call if it's an interface)
  p^ := aValue;
  inc(fCount);
  UpdateEnumerator(aIndex, eaAdded);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlListBase.DeleteIntern(const aIndex: Integer; const aFreeItem: Boolean);
var
  p: PT;
begin
  if (aIndex < 0) or (aIndex >= fCount) then
    raise EOutOfRangeException.Create(aIndex, 0, fCount-1);
  dec(fCount);
  p := GetInternalItem(aIndex);
  Release(p^, aFreeItem);
  System.Move((p+1)^, p^, SizeOf(T) * (fCount - aIndex));
  if CanShrink and (Capacity > 128) and (fCount < Capacity shr 2) then  // only 25% used
    SetCapacity(Capacity shr 1);                                        // set to 50% Capacity
  FillByte(GetInternalItem(fCount)^, (Capacity-fCount) * SizeOf(T), 0);
  UpdateEnumerator(aIndex, eaRemoved);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlListBase.GetEnumerator: IEnumerator;
begin
  result := TEnumerator.Create(self, false);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlListBase.GetUtlEnumerator: IutlEnumerator;
begin
  result := TEnumerator.Create(self, false);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlListBase.Clear;
begin
  while (Count > 0) do begin
    dec(fCount);
    Release(GetInternalItem(fCount)^, true);
  end;
  fCount := 0;
  if CanShrink then
    ShrinkToFit;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlListBase.ShrinkToFit;
begin
  Shrink(true);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlListBase.Create(const aOwnsItems: Boolean);
begin
  inherited Create(aOwnsItems);
  fCount := 0;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
destructor TutlListBase.Destroy;
begin
  Clear;
  inherited Destroy;
end;

end.