Containers 6. Abstract containers

Original in Russian: http://18delphi.blogspot.ru/2013/07/blog-post_3683.html

About containers. Table of contents

Now I want to tell about the practice of creating “pattern” container in “STL style”.

FOR NOW – WITHOUT the “true” Generics (http://18delphi.blogspot.com/2015/02/containers-3-generics-and-without.html). They ALSO can be used. But FOR NOW – there is a NUMBER OF UNCLOSED errors, which for some reason Embarcadero does not hurry to close. That is a weak point. What to say. Even my error (http://qc.embarcadero.com/wc/qcmain.aspx?d=116040 http://18delphi.blogspot.com/2013/05/xe4.html) - has been "kind of corrected", but not closed. Even so that was a minor matter. If I get it my way right...

One remark. Despite the fact that in STL such containers are called vector, I’ve decided to keep continuity with Delphi and name it List.

So. As usual.

The model:

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;
   f_Count : IndexType;
    {* The 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 }
 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_);
 protected
 // overridden protected methods
   procedure Cleanup; override;
     {* The function of object fields cleaning. }
 public
 // public properties
   property Count: IndexType
     read f_Count
     write pm_SetCount;
   property Capacity: IndexType
     read pm_GetCapacity
     write pm_SetCapacity;
   property Items[anIndex: IndexType]: _ItemType_
     read pm_GetItems
     write pm_SetItems;
     default;
     {* The items 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_.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
 
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}

UnrefcountedListPrim.imp.pas:

{$IfNDef UnrefcountedListPrim_imp}
 
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//
// The library "SandBox"
// The unit: "UnrefcountedListPrim.imp.pas"
// Native Delphi interfaces (.pas)
// Generated from UML model, root element: Impurity::Class Shared Delphi Sand Box::SandBox::STLLike::UnrefcountedListPrim
//
// The list of values without any reference counting
//
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 
{$Define UnrefcountedListPrim_imp}
 {$Define l3Items_IsUnrefcounted}
 
 _List_Parent_ = _UnrefcountedListPrim_Parent_;
 {$Include List.imp.pas}
 _UnrefcountedListPrim_ = {mixin} class(_List_)
  {* The list of values without any reference counting }
 end;//_UnrefcountedListPrim_
 
{$Else UnrefcountedListPrim_imp}
 
// start class _UnrefcountedListPrim_
 
function IsSame(const A: _ItemType_;
  const B: _ItemType_): Boolean;
//#UC START# *51DECB820261_51DED02E0163_var*
//#UC END# *51DECB820261_51DED02E0163_var*
begin
//#UC START# *51DECB820261_51DED02E0163_impl*
 Result := (A = B);
//#UC END# *51DECB820261_51DED02E0163_impl*
end;//IsSame
 
type _List_R_ = _UnrefcountedListPrim_;
 
{$Include List.imp.pas}
 
 
{$EndIf UnrefcountedListPrim_imp}

AtomicList.imp.pas:

{$IfNDef AtomicList_imp}
 
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//
// The library "SandBox"
// The unit: "AtomicList.imp.pas"
// Native Delphi interfaces (.pas)
// Generated from UML model, root element: Impurity::Class Shared Delphi Sand Box::SandBox::STLLike::AtomicList
//
// The list of atomic values
//
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 
{$Define AtomicList_imp}
 {$Define l3Items_IsAtomic}
 
 _UnrefcountedListPrim_Parent_ = _AtomicList_Parent_;
 {$Include UnrefcountedListPrim.imp.pas}
 _AtomicList_ = {mixin} class(_UnrefcountedListPrim_)
  {* The list of atomic values }
 end;//_AtomicList_
 
{$Else AtomicList_imp}
 
// start class _AtomicList_
 
procedure FillItem(var thePlace: _ItemType_;
  const aFrom: _ItemType_); forward;
 
procedure FreeItem(var thePlace: _ItemType_);
//#UC START# *51DEC20B01D7_51DED48301D9_var*
//#UC END# *51DEC20B01D7_51DED48301D9_var*
begin
//#UC START# *51DEC20B01D7_51DED48301D9_impl*
 thePlace := _ItemType_(0);
//#UC END# *51DEC20B01D7_51DED48301D9_impl*
end;//FreeItem
 
procedure FillItem(var thePlace: _ItemType_;
  const aFrom: _ItemType_);
//#UC START# *51DECB440087_51DED48301D9_var*
//#UC END# *51DECB440087_51DED48301D9_var*
begin
//#UC START# *51DECB440087_51DED48301D9_impl*
 thePlace := aFrom;
//#UC END# *51DECB440087_51DED48301D9_impl*
end;//FillItem
 
type _UnrefcountedListPrim_R_ = _AtomicList_;
 
{$Include UnrefcountedListPrim.imp.pas}
 
 
{$EndIf AtomicList_imp}

The code is here - http://sourceforge.net/p/rumtmarc/code-0/19/tree/trunk/Blogger/SandBox and http://sourceforge.net/p/rumtmarc/code-0/19/tree/trunk/Blogger/SandBoxTest