// $Id: dtypes.pas,v 1.18 2001/06/01 21:10:10 druid Exp $

unit dtypes;

interface

uses
    SysUtils,
    SyncObjs;

type
    GString = class
      value : string;

      constructor Create(s : string);
    end;

    GInteger = class
      value : integer;

      constructor Create(s : integer);
    end;

    GIterator = class
      function hasNext() : boolean; virtual; abstract;
      function next() : TObject; virtual; abstract;
    end;

    GListNode = class
      prev, next : GListNode;
      element : pointer;

      constructor Create(e : pointer; p, n : GListNode);
    end;

    GDLinkedList = class
      size : integer;
      head, tail : GListnode;
      lock : TCriticalSection;
      serial : integer;

      function insertLast(element : pointer) : GListNode;
      function insertAfter(tn : GListNode; element : pointer) : GListNode;
      function insertBefore(tn : GListNode; element : pointer) : GListNode;
      procedure remove(node : GListNode);
      procedure clean();
      procedure smallClean();

      function getSize() : integer;

      function iterator() : GIterator;

      constructor Create;
      destructor Destroy; override;
    end;

    GPrimes = array of integer;

    GHASH_FUNC = function(size, prime : cardinal; key : string) : integer;

    GHashValue = class
      key : variant;
      value : TObject;
      refcount : integer;
    end;

    // loosely based on the Java2 hashing classes
    GHashTable = class
      hashsize : cardinal;
      hashprime : cardinal;

      bucketList : array of GDLinkedList;

      hashFunc : GHASH_FUNC;

      procedure clear();

      function isEmpty() : boolean;
      function size() : integer;

      function iterator() : GIterator;

      function _get(key : variant) : GHashValue;

      function get(key : variant) : TObject;
      procedure put(key : variant; value : TObject);
      procedure remove(key : variant);

      function getHash(key : variant) : integer;
      procedure setHashFunc(func : GHASH_FUNC);
      function findPrimes(n : integer) : GPrimes;

      procedure hashStats(); virtual;

      constructor Create(size : integer);
      destructor Destroy; override;
    end;

    GException = class(Exception)
      e_location : string;

      constructor Create(location, msg : string);
      procedure show();
    end;

const STR_HASH_SIZE = 1024;

var
   str_hash : GHashTable;

function hash_string(src : string) : PString; overload;
function hash_string(src : PString) : PString; overload;

procedure unhash_string(var src : PString);

function defaultHash(size, prime : cardinal; key : string) : integer;
function firstHash(size, prime : cardinal; key : string) : integer;

implementation

{$IFDEF Grendel}
uses
    mudsystem;
{$ENDIF}


// GDLinkedListIterator
type
    GDLinkedListIterator = class(GIterator)
    private
      current : GListNode;

    published
      constructor Create(list : GDLinkedList);

      function hasNext() : boolean; override;
      function next() : TObject; override;
    end;

    GHashTableIterator = class(GIterator)
    private
      tbl : GHashTable;
      cursor : integer;
      current : GListNode;

    published
      constructor Create(table : GHashTable);

      function hasNext() : boolean; override;
      function next() : TObject; override;
    end;


// GString
constructor GString.Create(s : string);
begin
  inherited Create;

  value := s;
end;

// GInteger
constructor GInteger.Create(s : integer);
begin
  inherited Create;

  value := s;
end;

// GListNode
constructor GListNode.Create(e : pointer; p, n : GListNode);
begin
  inherited Create;

  element := e;
  next := n;
  prev := p;
end;

// GDLinkedListIterator
constructor GDLinkedListIterator.Create(list : GDLinkedList);
begin
  inherited Create;

  current := list.head;
end;

function GDLinkedListIterator.hasNext() : boolean;
begin
  Result := (current <> nil);
end;

function GDLinkedListIterator.next() : TObject;
begin
  Result := nil;

  if (hasNext()) then
    begin
    Result := current;

    current := current.next;
    end;
end;

// GHashTableIterator
constructor GHashTableIterator.Create(table : GHashTable);
begin
  inherited Create;

  tbl := table;

  current := nil;
  cursor := 0;

  while (current = nil) and (cursor < tbl.hashSize) do
    begin
    if (tbl.bucketlist[cursor].head <> nil) then
      current := tbl.bucketList[cursor].head;

    inc(cursor);
    end;
end;

function GHashTableIterator.hasNext() : boolean;
begin
  Result := (current <> nil);
end;

function GHashTableIterator.next() : TObject;
begin
  Result := nil;

  if (hasNext()) then
    begin
    Result := current;

    current := current.next;

    if (current = nil) then
      begin
      inc(cursor);

      while (current = nil) and (cursor < tbl.hashSize) do
        begin
        if (tbl.bucketlist[cursor].head <> nil) then
          current := tbl.bucketList[cursor].head;

        inc(cursor);
        end;
      end;
    end;
end;

// GDLinkedList
constructor GDLinkedList.Create;
begin
  inherited Create;

  head := nil;
  tail := nil;
  size := 0;
  serial := 1;
  lock := TCriticalSection.Create;
end;

destructor GDLinkedList.Destroy;
begin
  lock.Free;

  inherited Destroy;
end;

function GDLinkedList.insertLast(element : pointer) : GListNode;
var
   node : GListNode;
begin
  try
    lock.Acquire;

    node := GListNode.Create(element, tail, nil);

    if (head = nil) then
      head := node
    else
      tail.next := node;

    tail := node;

    insertLast := node;

    inc(size);
    inc(serial);
  finally
    lock.Release;
  end;
end;

function GDLinkedList.insertAfter(tn : GListNode; element : pointer) : GListNode;
var
   node : GListNode;
begin
  try
    lock.Acquire;

    node := GListNode.Create(element, tn, tn.next);

    if (tn.next <> nil) then
      tn.next.prev := node;

    tn.next := node;

    if (tail = tn) then
      tail := node;

    insertAfter := node;

    inc(serial);
    inc(size);
  finally
    lock.Release;
  end;
end;

function GDLinkedList.insertBefore(tn : GListNode; element : pointer) : GListNode;
var
   node : GListNode;
begin
  try
    lock.Acquire;

    node := GListNode.Create(element, tn.prev, tn);

    if (tn.prev <> nil) then
      tn.prev.next := node;
      
    tn.prev := node;

    if (head = tn) then
      head := node;

    insertBefore := node;

    inc(serial);
    inc(size);
  finally
    lock.Release;
  end;
end;

procedure GDLinkedList.remove(node : GListNode);
begin
  try
    lock.Acquire;

    if (node.prev = nil) then
      head := node.next
    else
      node.prev.next := node.next;

    if (node.next = nil) then
      tail := node.prev
    else
      node.next.prev := node.prev;

    dec(size);
    inc(serial);
    node.Free;
  finally
    lock.Release;
  end;
end;

function GDLinkedList.getSize : integer;
begin
  getSize := size;
end;

procedure GDLinkedList.clean;
var
   node : GListNode;
begin
  while (true) do
    begin
    node := tail;

    if (node = nil) then
      exit;

    TObject(node.element).Free;

    remove(node);
    end;
end;

// doesn't free elements
procedure GDLinkedList.smallClean;
var
   node : GListNode;
begin
  while (true) do
    begin
    node := head;

    if (node = nil) then
      exit;

    remove(node);
    end;
end;

function GDLinkedList.iterator() : GIterator;
begin
  Result := GDLinkedListIterator.Create(Self);
end;


// GHashTable
function defaultHash(size, prime : cardinal; key : string) : integer;
var
   i : integer;
   val : cardinal;
begin
  val := 0;

  for i := 1 to length(key) do
    val := val * prime + byte(key[i]);

  defaultHash := val mod size;
end;

function firstHash(size, prime : cardinal; key : string) : integer;
begin
  if (length(key) >= 1) then
    Result := (byte(key[1]) * prime) mod size
  else
    Result := 0;
end;

function GHashTable.findPrimes(n : integer) : GPrimes;
var
   i, j : integer;
   limit : double;
   numbers : GPrimes;
   numberpool : array of boolean;
begin
  setlength(numberpool, n);

  for i := 2 to n - 1 do
    numberpool[i] := true;

  limit := sqrt(n);

  j := 2;

  i := j + j;

  while (i < n) do
    begin
    numberpool[i] := false;
    i := i + j;
    end;

  j := 3;

  while (j <= limit) do
    begin
    if (numberpool[j] = true) then
      begin
      i := j + j;

      while (i < n) do
        begin
        numberpool[i] := false;

        i := i + j;
        end;
      end;

    j := j + 2;
    end;

  j := 0;

  for i := 0 to n - 1 do
    begin
    if (numberpool[i]) then
      begin
      setLength(numbers, j + 1);
      numbers[j] := i;
      j := j + 1;
      end;
    end;

  findPrimes := numbers;
end;

function GHashTable.getHash(key : variant) : integer;
begin
  Result := 0;
  if (varType(key) = varString) then
    Result := hashFunc(hashsize, hashprime, key)
  else
  if (varType(key) = varInteger) then
    Result := (key * hashprime) mod hashsize;
end;

procedure GHashTable.setHashFunc(func : GHASH_FUNC);
begin
  hashFunc := func;
end;

function GHashTable._get(key : variant) : GHashValue;
var
  hash : integer;
  node : GListNode;
begin
  Result := nil;
  hash := getHash(key);

  node := bucketList[hash].head;

  while (node <> nil) do
    begin
    if (GHashValue(node.element).key = key) then
      begin
      Result := node.element;
      break;
      end;

    node := node.next;
    end;
end;

function GHashTable.get(key : variant) : TObject;
var
  hv : GHashValue;
begin
  Result := nil;

  hv := _get(key);

  if (hv <> nil) then
    Result := hv.value;
end;

procedure GHashTable.put(key : variant; value : TObject);
var
   hash : integer;
   hv : GHashValue;
begin
  hv := _get(key);

  if (hv <> nil) then
    begin
    inc(hv.refcount);
    end
  else
    begin
    hash := getHash(key);

    hv := GHashValue.Create;
    hv.refcount := 1;
    hv.key := key;
    hv.value := value;

    bucketList[hash].insertLast(hv);
    end;
end;

procedure GHashTable.remove(key : variant);
var
  hash : integer;
  fnode, node : GListNode;
begin
  fnode := nil;
  hash := getHash(key);

  node := bucketList[hash].head;

  while (node <> nil) do
    begin
    if (GHashValue(node.element).key = key) then
      begin
      fnode := node;
      break;
      end;

    node := node.next;
    end;

  if (fnode <> nil) then
    bucketList[hash].remove(fnode);
end;

function GHashTable.size() : integer;
var
   i : integer;
   total : integer;
begin
  total := 0;

  for i := 0 to hashsize - 1 do
    begin
    total := total + bucketList[i].getSize;
    end;

  Result := total;
end;

function GHashTable.isEmpty() : boolean;
begin
  Result := size() = 0;
end;

procedure GHashTable.hashStats;
var
   i : integer;
   total : integer;
   load : single;
   min, max : integer;
begin
  total := 0;
  min := 65536;
  max := 0;

  for i := 0 to hashsize - 1 do
    begin
    total := total + bucketList[i].getSize;

    if (bucketList[i].getSize < min) then
      min := bucketList[i].getSize;
    if (bucketList[i].getSize > max) then
      max := bucketList[i].getSize;
    end;

  load := total / hashsize;

  writeln('Hash size ' + inttostr(hashsize) + ' with key ' + inttostr(hashprime));
  writeln('Total hash items : ' + inttostr(total));
  writeln('Load factor : ' + floattostrf(load, ffFixed, 7, 4));
end;

procedure GHashTable.clear();
var
   i : integer;
begin
  for i := 0 to hashsize - 1 do
    begin
    bucketList[i].clean;
    end;
end;

constructor GHashTable.Create(size : integer);
var
   n : integer;
   primes : GPrimes;
begin
  inherited Create;

  primes := findPrimes(size + 32);

  randomize;
  hashsize := primes[length(primes) - 1];
  hashprime := primes[random(length(primes))];

  setlength(bucketList, hashsize);

  for n := 0 to hashsize - 1 do
    bucketList[n] := GDLinkedList.Create;

  hashFunc := defaultHash;
end;

destructor GHashTable.Destroy;
var
   n : integer;
begin
  for n := 0 to hashsize - 1 do
    begin
    bucketList[n].clean;
    bucketList[n].Free;
    end;

  setlength(bucketList, 0);

  inherited Destroy;
end;

function GHashTable.iterator() : GIterator;
begin
  Result := GHashTableIterator.Create(Self);
end;


function hash_string(src : string) : PString;
var
  hv : GHashValue;
  g : GString;
begin
  hv := str_hash._get(src);

  if (hv <> nil) then
    begin
    hash_string := @GString(hv.value).value;
    inc(hv.refcount);
    end
  else
    begin
    g := GString.Create(src);

    str_hash.put(src, g);

    hash_string := @g.value;
    end;
end;

function hash_string(src : PString) : PString;
var
  hv : GHashValue;
  g : GString;
begin
  hv := str_hash._get(src^);

  if (hv <> nil) then
    begin
    hash_string := @GString(hv.value).value;
    inc(hv.refcount);
    end
  else
    begin
    g := GString.Create(src^);

    str_hash.put(src^, g);

    hash_string := @g.value;
    end;
end;

procedure unhash_string(var src : PString);
var
  hv : GHashValue;
begin
  if (src = nil) then
    exit;

  hv := str_hash._get(src^);

  if (hv <> nil) then
    begin
    dec(hv.refcount);

    if (hv.refcount <= 0) then
      begin
      str_hash.remove(src^);
      hv.value.Free;
      end;
    end;

  src := nil;
end;

// GException
constructor GException.Create(location, msg : string);
begin
  inherited Create(msg);
end;

procedure GException.show;
begin
{$IFDEF Grendel}
  write_console('Exception ' + Message + ' @ ' + e_location);
{$ELSE}
  writeln('Exception ' + Message + ' @ ' + e_location);
{$ENDIF}
end;

begin
  str_hash := GHashTable.Create(STR_HASH_SIZE);
end.