Containers 7. Abstract containers. Part 2

Original in Russian: http://18delphi.blogspot.ru/2013/07/2.html

About containers. Table of contents

The previous series was here - http://18delphi.blogspot.com/2015/02/containers-6-abstract-containers.html

Let’s extend the functionality of the container by adding the “standard” container operations.

As usual we’ll start with the model:

And the code:

List.imp.pas:

{$IfNDef List_imp}
 
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//
// The library "SandBox"
// The unit: "List.imp.pas"
// Native Delphi interfaces (.pas)
// Generated from UML model, root element: Impurity::Class Shared Delphi Sand Box::SandBox::STLLike::List
//
// The abstract list of values
//
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 
{$Define List_imp}
 PItemType = ^_ItemType_;
 
const
  { Sizes }
 cItemSize = SizeOf(_ItemType_);
 
type
 IndexType = System.Integer;
 
 _List_ = {mixin} class(_List_Parent_)
  {* The abstract list of values }
 private
 // private fields
   f_Data : Tl3PtrLoc;
    {* That is actually the place to store data }
   f_Count : IndexType;
    {* Field for the property Count}
 private
 // private methods
   procedure ReAllocList(aNewCapacity: IndexType);
   procedure CheckIndex(anIndex: IndexType); // can raise EListError
     {* checks the validity of the index and raises an exception if it is incorrect }
   function ItemSlot(anIndex: IndexType): PItemType;
   function ExpandSize(aTargetSize: IndexType): Cardinal;
   procedure CheckSetItem(anIndex: IndexType); // can raise EListError
     {* Checks the validity of the index upon insert }
   procedure DirectInsert(anIndex: IndexType;
     const anItem: _ItemType_);
     {* Direct adding of the item. Without checking the validity of the index }
   procedure MoveItems(aDst: IndexType;
     aSrc: IndexType;
     aSize: Cardinal);
 protected
 // property methods
   procedure pm_SetCount(aValue: IndexType);
   function pm_GetCapacity: IndexType;
   procedure pm_SetCapacity(aValue: IndexType);
   function pm_GetItems(anIndex: IndexType): _ItemType_;
   procedure pm_SetItems(anIndex: IndexType; const aValue: _ItemType_);
   function pm_GetEmpty: Boolean;
   function pm_GetFirst: _ItemType_;
   function pm_GetLast: _ItemType_;
 protected
 // overridden protected methods
   procedure Cleanup; override;
     {* The function of object fields cleaning. }
 public
 // public methods
   procedure Delete(anIndex: IndexType); // can raise EListError
     {* delete the item with index anIndex }
   procedure Insert(anIndex: IndexType;
     const anItem: _ItemType_); // can raise EListError
     {* Adding of the item }
   procedure Add(const anItem: _ItemType_);
     {* Adds an item of the list }
   function IndexOf(const anItem: _ItemType_): IndexType;
     {* Returns the index of the list item or -1, if there is no item in the list }
   procedure Remove(const anIndex: _ItemType_);
     {* Deletes an item from the list }
   procedure Clear;
     {* Clears the list }
 public
 // public properties
   property Count: IndexType
     read f_Count
     write pm_SetCount;
     {* The number of items in the list }
   property Capacity: IndexType
     read pm_GetCapacity
     write pm_SetCapacity;
     {* The capacity of the list }
   property Items[anIndex: IndexType]: _ItemType_
     read pm_GetItems
     write pm_SetItems;
     default;
     {* The items of the list. }
   property Empty: Boolean
     read pm_GetEmpty;
     {* The list is empty }
   property First: _ItemType_
     read pm_GetFirst;
     {* The first item of the list }
   property Last: _ItemType_
     read pm_GetLast;
     {* The last item of the list }
 end;//_List_
 
{$Else List_imp}
 
// start class _List_
 
procedure _List_.ReAllocList(aNewCapacity: IndexType);
//#UC START# *51DEB8770017_51DEB07E03E4_var*
var
 l_Cap : Integer;
 l_Cnt : Integer;
//#UC END# *51DEB8770017_51DEB07E03E4_var*
begin
//#UC START# *51DEB8770017_51DEB07E03E4_impl*
 f_Data.SetSize(aNewCapacity * cItemSize);
 l_Cap := Self.Capacity;
 Assert(l_Cap >= aNewCapacity);
 l_Cnt := f_Count;
 if (l_Cap > l_Cnt) then
  System.FillChar(ItemSlot(l_Cnt)^, (l_Cap - l_Cnt) * cItemSize, 0);
//#UC END# *51DEB8770017_51DEB07E03E4_impl*
end;//_List_.ReAllocList
 
procedure _List_.CheckIndex(anIndex: IndexType); // can raise EListError
//#UC START# *51DEB95E00BD_51DEB07E03E4_var*
 
 procedure _Error;
 begin
  raise EListError.CreateFmt(SListIndexError + ' from (%d)', [anIndex, f_Count])
 end;
 
//#UC END# *51DEB95E00BD_51DEB07E03E4_var*
begin
//#UC START# *51DEB95E00BD_51DEB07E03E4_impl*
 if (anIndex < 0) or (anIndex >= f_Count) then
  _Error;
//#UC END# *51DEB95E00BD_51DEB07E03E4_impl*
end;//_List_.CheckIndex
 
function _List_.ItemSlot(anIndex: IndexType): PItemType;
//#UC START# *51DEBE2D008A_51DEB07E03E4_var*
//#UC END# *51DEBE2D008A_51DEB07E03E4_var*
begin
//#UC START# *51DEBE2D008A_51DEB07E03E4_impl*
 Result := PItemType(f_Data.AsPointer + anIndex * cItemSize);
 assert(Result <> nil);
//#UC END# *51DEBE2D008A_51DEB07E03E4_impl*
end;//_List_.ItemSlot
 
function _List_.ExpandSize(aTargetSize: IndexType): Cardinal;
//#UC START# *51DEC11F0058_51DEB07E03E4_var*
const
 cIncrArray : array [0..3] of Integer = (64 * 1024, 1024, 128, 4);
 cMaxForTwice : Integer = 1 * 1024 * 1024;
var
 I : Integer;
//#UC END# *51DEC11F0058_51DEB07E03E4_var*
begin
//#UC START# *51DEC11F0058_51DEB07E03E4_impl*
 Assert(aTargetSize > 0);
 
 Result := aTargetSize;
 if (Result > cMaxForTwice) then
 // we do not double large arrays, but even them to 1 Mb 
  Result := (aTargetSize div cMaxForTwice + 1) * cMaxForTwice
 else
 begin
  for I := 0 to High(cIncrArray) do
   if (aTargetSize > cIncrArray[I]) then
   begin
    Result := (aTargetSize div cIncrArray[I]) * cIncrArray[I] * 2;
    Break;
   end;//aTargetSize > cIncrArray[I]
 end;//Result > cMaxForTwic
//#UC END# *51DEC11F0058_51DEB07E03E4_impl*
end;//_List_.ExpandSize
 
procedure _List_.CheckSetItem(anIndex: IndexType); // can raise EListError
//#UC START# *51DECAA8035E_51DEB07E03E4_var*
//#UC END# *51DECAA8035E_51DEB07E03E4_var*
begin
//#UC START# *51DECAA8035E_51DEB07E03E4_impl*
 CheckIndex(anIndex);
//#UC END# *51DECAA8035E_51DEB07E03E4_impl*
end;//_List_.CheckSetItem
 
procedure _List_.DirectInsert(anIndex: IndexType;
  const anItem: _ItemType_);
//#UC START# *51E6A2AA02E4_51DEB07E03E4_var*
var
 l_Cap   : Integer;
 l_Count : Integer;
//#UC END# *51E6A2AA02E4_51DEB07E03E4_var*
begin
//#UC START# *51E6A2AA02E4_51DEB07E03E4_impl*
 l_Count := f_Count;
 l_Cap := Self.Capacity;
 if (l_Count >= l_Cap) then
  ReAllocList(ExpandSize(l_Cap + 1));
 { Make room for the inserted item. }
 Dec(l_Count, anIndex);
 if (l_Count > 0) then
 begin
  MoveItems(anIndex + 1, anIndex + 0, l_Count);
  {$If not defined(l3Items_IsAtomic)}
  FillChar(PMem(ItemSlot(anIndex))^, cItemSize, 0);
  // - To ensure that there is no odd reference to the lines and/or the interfaces 
  {$IfEnd}
 end;//l_Count > 0
 FillItem(ItemSlot(anIndex)^, anItem);
 Inc(f_Count);
 {$IfDef l3Items_IsAtomic}
 Assert(ItemSlot(anIndex)^ = anItem);
 {$Else  l3Items_IsAtomic}
 {$If (SizeOf(_ItemType_) <= 4) AND not Defined(l3Items_IsProcedured)}
 Assert(ItemSlot(anIndex)^ = anItem);
 {$IfEnd}
 {$EndIf l3Items_IsAtomic}
//#UC END# *51E6A2AA02E4_51DEB07E03E4_impl*
end;//_List_.DirectInsert
 
procedure _List_.MoveItems(aDst: IndexType;
  aSrc: IndexType;
  aSize: Cardinal);
//#UC START# *51E6A8190252_51DEB07E03E4_var*
type
 PInteger = ^Integer;
var
 l_Sz : Integer;
 l_S  : Integer;
 l_D  : Integer;
 l_B  : PMem;
//#UC END# *51E6A8190252_51DEB07E03E4_var*
begin
//#UC START# *51E6A8190252_51DEB07E03E4_impl*
 if (aSize > 0) then
 begin
  l_B := f_Data.AsPointer;
  l_S := aSrc * cItemSize;
  l_D := aDst * cItemSize;
  l_Sz := aSize * cItemSize;
  if (l_Sz = SizeOf(Integer)) then
  begin
   PInteger(l_B + l_D)^ := PInteger(l_B + l_S)^;
   Exit;
  end//l_Sz = SizeOf(Integer)
  else
   Move((l_B + l_S)^, (l_B + l_D)^, l_Sz);
 end;//aSize > 0
//#UC END# *51E6A8190252_51DEB07E03E4_impl*
end;//_List_.MoveItems
 
procedure _List_.Delete(anIndex: IndexType); // can raise EListError
//#UC START# *51E6A2660270_51DEB07E03E4_var*
var
 l_P : PItemType;
//#UC END# *51E6A2660270_51DEB07E03E4_var*
begin
//#UC START# *51E6A2660270_51DEB07E03E4_impl*
 CheckIndex(anIndex);
 l_P := ItemSlot(anIndex);
 Dec(f_Count);
 FreeItem(l_P^);
 if (anIndex <> f_Count) then
  MoveItems(anIndex, Succ(anIndex), f_Count-anIndex);
//#UC END# *51E6A2660270_51DEB07E03E4_impl*
end;//_List_.Delete
 
procedure _List_.Insert(anIndex: IndexType;
  const anItem: _ItemType_); // can raise EListError
//#UC START# *51E6A3140016_51DEB07E03E4_var*
 
 procedure _Error;
 begin
  raise EListError.CreateFmt(SListIndexError, [anIndex]);
 end;
 
//#UC END# *51E6A3140016_51DEB07E03E4_var*
begin
//#UC START# *51E6A3140016_51DEB07E03E4_impl*
 if (anIndex < 0) or (anIndex > f_Count) then
  _Error;
 DirectInsert(anIndex, anItem) 
//#UC END# *51E6A3140016_51DEB07E03E4_impl*
end;//_List_.Insert
 
procedure _List_.Add(const anItem: _ItemType_);
//#UC START# *51E80192036C_51DEB07E03E4_var*
//#UC END# *51E80192036C_51DEB07E03E4_var*
begin
//#UC START# *51E80192036C_51DEB07E03E4_impl*
 DirectInsert(f_Count, anItem);
//#UC END# *51E80192036C_51DEB07E03E4_impl*
end;//_List_.Add
 
function _List_.IndexOf(const anItem: _ItemType_): IndexType;
//#UC START# *51E801D503C5_51DEB07E03E4_var*
var
 l_Index : IndexType;
//#UC END# *51E801D503C5_51DEB07E03E4_var*
begin
//#UC START# *51E801D503C5_51DEB07E03E4_impl*
 Result := -1;
 // - let’s be pessimistic
 for l_Index := 0 to f_Count - 1 do
 begin
  if IsSame(ItemSlot(l_Index)^, anItem) then
  begin
   Result := l_Index;
   break;
  end;//IsSame(ItemSlot(l_Index)^, anItem)
 end;//for l_Index
//#UC END# *51E801D503C5_51DEB07E03E4_impl*
end;//_List_.IndexOf
 
procedure _List_.Remove(const anIndex: _ItemType_);
//#UC START# *51E802290167_51DEB07E03E4_var*
var
 l_Index : IndexType;
//#UC END# *51E802290167_51DEB07E03E4_var*
begin
//#UC START# *51E802290167_51DEB07E03E4_impl*
 l_Index := IndexOf(anIndex);
 if (l_Index >= 0) then
  Delete(l_Index);
//#UC END# *51E802290167_51DEB07E03E4_impl*
end;//_List_.Remove
 
procedure _List_.Clear;
//#UC START# *51E8026302B4_51DEB07E03E4_var*
//#UC END# *51E8026302B4_51DEB07E03E4_var*
begin
//#UC START# *51E8026302B4_51DEB07E03E4_impl*
 Count := 0;
//#UC END# *51E8026302B4_51DEB07E03E4_impl*
end;//_List_.Clear
 
procedure _List_.pm_SetCount(aValue: IndexType);
//#UC START# *51DEB1ED0017_51DEB07E03E4set_var*
 
 procedure SayBadCount(aNewCount: LongInt);
 begin
  raise EListError.CreateFmt(sListIndexError, [aNewCount]);
 end;
 
var
 l_Ptr   : PItemType;
 {$IfNDef l3Items_IsUnrefcounted}
 l_Index : Integer;
 {$EndIf  l3Items_IsUnrefcounted}
//#UC END# *51DEB1ED0017_51DEB07E03E4set_var*
begin
//#UC START# *51DEB1ED0017_51DEB07E03E4set_impl*
 if (aValue < 0) then
  SayBadCount(aValue);
 if (aValue < f_Count) then
 begin
  l_Ptr := ItemSlot(aValue);
  {$IfDef l3Items_IsUnrefcounted}
  System.FillChar(l_Ptr^, (f_Count - 1 - aValue) * cItemSize, 0);
  {$Else  l3Items_IsUnrefcounted}
  for l_Index := aValue to f_Count - 1 do
  begin
   FreeItem(l_Ptr^);
   Inc(PMem(l_Ptr), cItemSize);
  end;//for i
  {$EndIf  l3Items_IsUnrefcounted}
 end//aValue < f_Count
 else
 if (aValue > Self.Capacity) then
  ReAllocList(ExpandSize(aValue));
 if (f_Count < aValue) then
  System.FillChar(ItemSlot(f_Count)^, (aValue - f_Count) * cItemSize, 0);
 f_Count := aValue;
//#UC END# *51DEB1ED0017_51DEB07E03E4set_impl*
end;//_List_.pm_SetCount
 
function _List_.pm_GetCapacity: IndexType;
//#UC START# *51DEB20E0130_51DEB07E03E4get_var*
//#UC END# *51DEB20E0130_51DEB07E03E4get_var*
begin
//#UC START# *51DEB20E0130_51DEB07E03E4get_impl*
 Result := f_Data.GetSize div cItemSize;
//#UC END# *51DEB20E0130_51DEB07E03E4get_impl*
end;//_List_.pm_GetCapacity
 
procedure _List_.pm_SetCapacity(aValue: IndexType);
//#UC START# *51DEB20E0130_51DEB07E03E4set_var*
 
 procedure SayBadCap(aNewCapacity: IndexType);
 begin
  raise EListError.CreateFmt(sListIndexError, [aNewCapacity]);
 end;
 
//#UC END# *51DEB20E0130_51DEB07E03E4set_var*
begin
//#UC START# *51DEB20E0130_51DEB07E03E4set_impl*
 if (aValue < 0) then
  SayBadCap(aValue);
 if (pm_GetCapacity <> aValue) then
 begin
  { If the list is shrinking, then update _Count for the smaller size. }
  if (aValue < f_Count) then
   Count := aValue;
  ReAllocList(aValue);
 end;//GetCapacity(Self) <> aValue
//#UC END# *51DEB20E0130_51DEB07E03E4set_impl*
end;//_List_.pm_SetCapacity
 
function _List_.pm_GetItems(anIndex: IndexType): _ItemType_;
//#UC START# *51DECA1202C5_51DEB07E03E4get_var*
//#UC END# *51DECA1202C5_51DEB07E03E4get_var*
begin
//#UC START# *51DECA1202C5_51DEB07E03E4get_impl*
 CheckIndex(anIndex);
 Result := ItemSlot(anIndex)^;
//#UC END# *51DECA1202C5_51DEB07E03E4get_impl*
end;//_List_.pm_GetItems
 
procedure _List_.pm_SetItems(anIndex: IndexType; const aValue: _ItemType_);
//#UC START# *51DECA1202C5_51DEB07E03E4set_var*
{$IfNDef l3Items_IsAtomic}
var
 l_P : PItemType;
{$EndIf  l3Items_IsAtomic}
//#UC END# *51DECA1202C5_51DEB07E03E4set_var*
begin
//#UC START# *51DECA1202C5_51DEB07E03E4set_impl*
 CheckSetItem(anIndex);
 {$IfDef l3Items_IsAtomic}
 PItemType(ItemSlot(anIndex))^ := aValue;
 {$Else  l3Items_IsAtomic}
 l_P := PItemType(ItemSlot(anIndex));
 if not IsSame(l_P^, aValue) then
 begin
  FreeItem(l_P^);
  FillItem(l_P^, aValue);
 end;//not IsSame(l_P^, anItem)
 {$EndIf l3Items_IsAtomic}
//#UC END# *51DECA1202C5_51DEB07E03E4set_impl*
end;//_List_.pm_SetItems
 
function _List_.pm_GetEmpty: Boolean;
//#UC START# *51E7FDAC023D_51DEB07E03E4get_var*
//#UC END# *51E7FDAC023D_51DEB07E03E4get_var*
begin
//#UC START# *51E7FDAC023D_51DEB07E03E4get_impl*
 Result := (Count = 0);
//#UC END# *51E7FDAC023D_51DEB07E03E4get_impl*
end;//_List_.pm_GetEmpty
 
function _List_.pm_GetFirst: _ItemType_;
//#UC START# *51E8070603AC_51DEB07E03E4get_var*
//#UC END# *51E8070603AC_51DEB07E03E4get_var*
begin
//#UC START# *51E8070603AC_51DEB07E03E4get_impl*
 Result := Items[0];
//#UC END# *51E8070603AC_51DEB07E03E4get_impl*
end;//_List_.pm_GetFirst
 
function _List_.pm_GetLast: _ItemType_;
//#UC START# *51E8074101B5_51DEB07E03E4get_var*
//#UC END# *51E8074101B5_51DEB07E03E4get_var*
begin
//#UC START# *51E8074101B5_51DEB07E03E4get_impl*
 Result := Items[f_Count - 1];
//#UC END# *51E8074101B5_51DEB07E03E4get_impl*
end;//_List_.pm_GetLast
 
procedure _List_.Cleanup;
//#UC START# *479731C50290_51DEB07E03E4_var*
//#UC END# *479731C50290_51DEB07E03E4_var*
begin
//#UC START# *479731C50290_51DEB07E03E4_impl*
 Count := 0;
 f_Data.SetSize(0);
 inherited;
//#UC END# *479731C50290_51DEB07E03E4_impl*
end;//_List_.Cleanup
 
{$EndIf List_imp}

InterfacePtrList.imp.pas:

{$IfNDef InterfacePtrList_imp}
 
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//
// The library "SandBox"
// The unit: "InterfacePtrList.imp.pas"
// Native Delphi interfaces (.pas)
// Generated from UML model, root element: Impurity::Class Shared Delphi Sand Box::SandBox::STLLike::InterfacePtrList
//
// The list of the pointers to the interfaces. Does not have its items
//
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 
{$Define InterfacePtrList_imp}
 _List_Parent_ = _InterfacePtrList_Parent_;
 {$Include ..\SandBox\List.imp.pas}
 _InterfacePtrList_ = {mixin} class(_List_)
  {* The list of the pointers to the interfaces. Does not have its items }
 end;//_InterfacePtrList_
 
{$Else InterfacePtrList_imp}
 
// start class _InterfacePtrList_
 
procedure FillItem(var thePlace: _ItemType_;
  const aFrom: _ItemType_); forward;
 
function IsSame(const A: _ItemType_;
  const B: _ItemType_): Boolean; forward;
 
procedure FreeItem(var thePlace: _ItemType_);
//#UC START# *51DEC20B01D7_51E8098001DC_var*
//#UC END# *51DEC20B01D7_51E8098001DC_var*
begin
//#UC START# *51DEC20B01D7_51E8098001DC_impl*
 !!! Needs to be implemented !!!
//#UC END# *51DEC20B01D7_51E8098001DC_impl*
end;//FreeItem
 
procedure FillItem(var thePlace: _ItemType_;
  const aFrom: _ItemType_);
//#UC START# *51DECB440087_51E8098001DC_var*
//#UC END# *51DECB440087_51E8098001DC_var*
begin
//#UC START# *51DECB440087_51E8098001DC_impl*
 !!! Needs to be implemented !!!
//#UC END# *51DECB440087_51E8098001DC_impl*
end;//FillItem
 
function IsSame(const A: _ItemType_;
  const B: _ItemType_): Boolean;
//#UC START# *51DECB820261_51E8098001DC_var*
//#UC END# *51DECB820261_51E8098001DC_var*
begin
//#UC START# *51DECB820261_51E8098001DC_impl*
 !!! Needs to be implemented !!!
//#UC END# *51DECB820261_51E8098001DC_impl*
end;//IsSame
 
{$Include ..\SandBox\List.imp.pas}
 
 
{$EndIf InterfacePtrList_imp}

InterfaceRefList.imp.pas:

{$IfNDef InterfaceRefList_imp}
 
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//
// The library "SandBox"
// The unit: "InterfaceRefList.imp.pas"
// Native Delphi interfaces (.pas)
// Generated from UML model, root element: Impurity::Class Shared Delphi Sand Box::SandBox::STLLike::InterfaceRefList
//
// The list of the references to the interfaces. It has its items
//
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 
{$Define InterfaceRefList_imp}
 _List_Parent_ = _InterfaceRefList_Parent_;
 {$Include ..\SandBox\List.imp.pas}
 _InterfaceRefList_ = {mixin} class(_List_)
  {* The list of the references to the interfaces. It has its items }
 end;//_InterfaceRefList_
 
{$Else InterfaceRefList_imp}
 
// start class _InterfaceRefList_
 
procedure FillItem(var thePlace: _ItemType_;
  const aFrom: _ItemType_); forward;
 
function IsSame(const A: _ItemType_;
  const B: _ItemType_): Boolean; forward;
 
procedure FreeItem(var thePlace: _ItemType_);
//#UC START# *51DEC20B01D7_51E809AD001D_var*
//#UC END# *51DEC20B01D7_51E809AD001D_var*
begin
//#UC START# *51DEC20B01D7_51E809AD001D_impl*
 thePlace := nil;
//#UC END# *51DEC20B01D7_51E809AD001D_impl*
end;//FreeItem
 
procedure FillItem(var thePlace: _ItemType_;
  const aFrom: _ItemType_);
//#UC START# *51DECB440087_51E809AD001D_var*
//#UC END# *51DECB440087_51E809AD001D_var*
begin
//#UC START# *51DECB440087_51E809AD001D_impl*
 thePlace := afrom;
//#UC END# *51DECB440087_51E809AD001D_impl*
end;//FillItem
 
function IsSame(const A: _ItemType_;
  const B: _ItemType_): Boolean;
//#UC START# *51DECB820261_51E809AD001D_var*
//#UC END# *51DECB820261_51E809AD001D_var*
begin
//#UC START# *51DECB820261_51E809AD001D_impl*
 Result := (A = B);
//#UC END# *51DECB820261_51E809AD001D_impl*
end;//IsSame
 
{$Include ..\SandBox\List.imp.pas}
 
 
{$EndIf InterfaceRefList_imp}