decal.pas

C++中的STL真的让人爱不释手,如果你使用DELPHI,现在你也有了类似于STL的标准库,还不赶快下载啊!

{**

	Copyright (c) 2000 Ross Judson<P>

	DeCAL is licensed under the terms of the Mozilla Public License.  <P>

  The contents of this file are subject to the Mozilla Public License
  Version 1.0 (the "License"); you may not use this file except in
  compliance with the License. You may obtain a copy of the
  License at http://www.mozilla.org/MPL/ <P>

	Use tab size 2. DeCAL code can be processed with DelphiDoc to yield
  HTML documentation.  <P>

	<STRONG>
	Delphi Container and Algorithm Library 1.0
	</STRONG><P>

	Author: Ross Judson                  <BR>
					[e-mail]            <P>

	Stepanov's Standard Template Library for C++ demonstrated the power of
	generic programming.  I purchased ObjectSpace's implementation of STL and,
	after climbing the learning curve, came to appreciate the leverage it
	gave me when tackling tough problems.  <P>

	Java lacked the same capabilities until ObjectSpace released JGL, the
	Java Generic Library, which is modelled on STL.  The hierarchies and
	methods that Stepanov designed were extended into Java, with the
	peculiarities and powers of that language well taken into account.  No
	serious Java developer should be without JGL, and no serious C++ developer
	should be without STL.  <P>

	Delphi programmers have lacked similar generic algorithms and containers.
	The container classes provided with Delphi are, at best, primitive.  They
	are, though, easy to use, which is their saving grace.  Serious Delphi
	applications usually try to bend the existing data structures to their
	needs, with varying degrees of success.  <P>

	There also exist one or two simple data structures libraries.  One of these,
	Julian Bucknall's EZStruct, implements a number of useful structures.  I have
	used EZStruct very successfully in the past, but had difficulty with its
	inability to store atomic types and use generic algorithms.  <P>

	What previous solutions were lacking was the strong theoretical foundation
	that the STL model provides for generic programming, and the large number
	of generic algorithms that come along with it.  <P>

	DeCAL brings this power to Delphi developers.  I hope you enjoy using it, and
	I hope that it saves you time and effort.  <P>

	Learn the algorithms, and what they do!  The secret to effectively using
	STL, JGL, and DeCAL is developing an implementation vocabulary that
	frequently makes use of the generic algorithms.  <P>

	DeCAL is packaged into a single unit to make it easy to include in your
	programs.  Some of the names are rather common -- just use DeCAL.xxxxxx to
	call a function if there's a conflict.  <P>

  I wish to express my appreciation to the following authors, whose work has
  helped me own.  <P>

  Martin Waldenburg <BR>
  Julian Bucknall <BR>
  Vladimir Merzlaikov <BR>
	Kurt Westerfeld <P>

}

unit DeCAL;

{$IFDEF VER100}
{$DEFINE DELPHI3}
{$ENDIF}

{$IFDEF VER110}
{$DEFINE DELPHI3}
{$ENDIF}

{$IFDEF VER120}
{$DEFINE DELPHI4}
{$ENDIF}

{$IFDEF VER130}
{$DEFINE DELPHI5}
{$ENDIF}

// {$DEFINE DEBUG}
{$DEFINE USEPOOLS}

{$IFDEF DELPHI3}
{$ELSE}
{$DEFINE USELONGWORD}
{$ENDIF}

// can't seem to ifopt these
//{$IFOPT WARNINGS+}
{$DEFINE WARNINGSON}
//{$ENDIF}
//{$IFOPT HINTS+}
{$DEFINE HINTSON}
//{$ENDIF}

interface

uses Windows, Classes, SysUtils
{$IFDEF GC}
			,gc
{$ENDIF}

;

const
	DefaultArraySize = 16;
	DefaultBucketCount = 128;

type

	{** DeCALBase class is used as the ultimate base for all DeCAL objects.  We do
	this so we can potentially garbage collect them. }
{$IFDEF GC}
	DBaseClass = TGcObject;
{$ELSE}
	DBaseClass = TObject;
{$ENDIF}

{$IFDEF USELONGWORD}
	DeCALDWord = LongWord;
{$ELSE}
	DeCALDWORD = Integer;
{$ENDIF}

	{** DObject are TVarRecs, and can store any kind of atomic value. }
	DObject = TVarRec;

	{** DArrays keep arrays of DObjects.  We declare them using the MaxInt
	notation so that they can be of any length. }
	DObjectArray = array[0..MaxInt div sizeof(DObject) - 1] of DObject;
	{** A pointer to an arbitrarily sized array of DObjects. }
	PDObjectArray = ^DObjectArray;

	{** A pointer to an individual DObject. }
	PDObject = ^DObject;

	{$DEFINE FREEPOSSIBLE}

	////////////////////////////////////////////////////////////////////
	//
	// Forward Declarations
	//
	////////////////////////////////////////////////////////////////////
	DIterHandler = class;
	DContainer = class;
	DListNode = class;
	DTreeNode = class;
	DRedBlackTree = class;

	////////////////////////////////////////////////////////////////////
	//
	// Iterators
	//
	////////////////////////////////////////////////////////////////////

	{** Flags that can exist on iterators.
	<DL>
	<DT>
	diSimple          </DT><DD>
	Indicates that the iterator is of the most basic type.</DD>

	<DT>
	diForward          </DT><DD>
	An iterator that can move forward only (like for single-
	linked lists).</DD>

	<DT>
	diBidirectional     </DT><DD>
	An iterator that can move forward and backward.</DD>

	<DT>
  diRandom             </DT><DD>An iterator that can move forward and backward, or to
  a particular element quickly (indexed access).</DD>
  </DL>}
	DIteratorFlag = (diSimple, diForward, diBidirectional, diRandom, diMarkStart, diMarkFinish, diKey, diIteration);
  DIteratorFlags = set of DIteratorFlag;

  {** Different underlying containers for an iterator. }
	DIteratorStucture = (dsArray, dsList, dsMap, dsSet, dsDeque, dsHash);

  {** DIterators store positional information within a container.
  I'm using a record structure here because records are assignable in Delphi.
	We want to be able to pass these iterators around freely, and not have to worry
  about continually constructing them and destroying them.  That precludes using
  the object model. }
  PDIterator = ^DIterator;
	DIterator = record
		flags : DIteratorFlags;
		Handler : DIterHandler;
		case DIteratorStucture of
			dsArray: ( position : Integer);
			dsList: (dnode : DListNode);
			dsMap, dsSet : (tree : DRedBlackTree; treeNode : DTreeNode);

      // bucketPosition is placed first so that we can pass this same iterator
      // to a secondary sequential structure (like DArray or DList) and make
      // use of the same iterator.  The problem is that we need to iterate
      // over two structures simultaneously.
			dsDeque, dsHash: ( bucketPosition, bucket : Integer);
	end;

  {** A DRange stores the beginning and ending to a range within a container. }
	DRange = record
		start, finish : DIterator;
	end;

	////////////////////////////////////////////////////////////////////
	//
	// General Structures
	//
	////////////////////////////////////////////////////////////////////

  {** DPairs store two complete DObjects.  They are frequently used by maps
  to contain key, value pairs. }
	DPair = record
		first, second : DObject;
	end;


	{** Contains a pair of iterators.  Not the same as a range -- ranges
	 will have two iterators that are from the same container.  DIteratorPairs
	 usually have iterators from two different containers. }
	DIteratorPair = record
		first, second : DIterator;
	end;

	////////////////////////////////////////////////////////////////////
	//
	// Exceptions
	//
	////////////////////////////////////////////////////////////////////

  {** DeCALException is the base of all exceptions thrown by DeCAL. All exceptions
  thrown should descend from here. }
	DException = class(Exception)
	end;

  {** An exception indicating that the function has not yet been implemented. }
	DNotImplemented = class(DException)
		constructor Create;
	end;

  {** Exception, upon needing a bidirectional iterator.  The iterator supplied
  is not bidirectional, or better. }
	DNeedBidirectional = class(DException)
		constructor Create;
	end;

  {** Exception upon needing a random access iterator.  The container can't
  support the operation being performed.  }
	DNeedRandom = class(DException)
		constructor Create;
	end;

  {** Exception upon acting on an empty container.  The operation being performed
  requires that the container be non-empty. }
	DEmpty = class(Exception)
		constructor Create;
	end;

	////////////////////////////////////////////////////////////////////
	//
	// Comparison
	//
	////////////////////////////////////////////////////////////////////

	{** A closure that can compare two objects and returns less than zero if
  obj1 is less than obj2, 0 if obj1 equals obj2, and greater than zero if
  obj1 is greater than obj2;
  @param obj1 The first object (left hand side).
  @param obj2 The second object (right hand side).}
	DComparator = function (const obj1, obj2 : DObject) : Integer of object;

  {** A procedural equivalent to the DComparator closure.  Use these when you
  want your comparator to be a procedure instead of a closure. They can be
  converted to DComparator with the MakeComparator function. }
	DComparatorProc = function(ptr : Pointer; const obj1, obj2 : DObject) : Integer;

	{** Test to see if the two objects are the same. }
	DEquals = function(const obj1, obj2 : DObject) : Boolean of object;
  {** Procedural equivalent to DEquals. }
	DEqualsProc = function(ptr : Pointer; const obj1, obj2 : DObject) : Boolean;

	{** Apply a generic test to an object.  Usually used to select objects from
	 a container. }
	DTest = function(const obj : DObject) : Boolean of object;
  {** Procedural equivalent to DTest. }
	DTestProc = function(ptr : Pointer; const obj : DObject) : Boolean;

	{** Apply a test to two objects. }
	DBinaryTest = function(const obj1, obj2 : DObject) : Boolean of object;
  {** Procedural equivalent to DBinaryTest. }
	DBinaryTestProc = function(ptr : Pointer; const obj1, obj2 : DObject) : Boolean;

	{** Apply a function to an object.  Usually used in apply functions. }
  DApply = procedure(const obj : DObject) of object;
  {** Procedural equivalent to DApply. }
  DApplyProc = procedure(ptr : Pointer; const obj : DObject);

	{** Apply a function to an object.  Usually used in collect functions. }
	DUnary = function(const obj : DObject) : DObject of object;
  {** Procedural equivalent to DUnary. }
	DUnaryProc = function(ptr : Pointer; const obj : DObject) : DObject;

	{** Apply a function to two objects.  Usually used in transform functions. }
	DBinary = function(const obj1, obj2 : DObject) : DObject of object;
  {** Procedural equivalent to DBinary. }
	DBinaryProc = function(ptr : Pointer; const obj1, obj2 : DObject) : DObject;

  {** A generator creates DObjects. }
  DGenerator = function : DObject of object;

  {** Procedural equivalent to DGenerator.}
  DGeneratorProc = function(ptr : Pointer) : DObject;


	////////////////////////////////////////////////////////////////////
	//
	// IterHandler
	//
	////////////////////////////////////////////////////////////////////

  {**
		This class is defined separately so that we can create special types
    of iterators that aren't actually containers.  For example, we can
    create an iterator that can put objects to an object stream, or an
    iterator that filters another iterator.