{$MODE FPC}
{$MODESWITCH ADVANCEDRECORDS}
{$MODESWITCH OUT}
{$MODESWITCH RESULT}
unit dgraph;

interface

uses
  dpooledlist;

type
PGraph = ^TGraph;
TGraph = object
private type
  TLists = specialize TPooledLists<Pointer, TPooledListDefaultStaticInfo>;
  PListItem = TLists.PListItem;
  TListItem = TLists.TListItem;
  PItem = ^TItem;
  TItem = packed record
    P: Pointer;
    Next: PItem;
  end;
  PPage = ^TPage;
  TPage = PItem;
  PTable = ^TTable;
  TTable = packed record
    P: Pointer;
    List: PItem;
    Next: PTable;
  end;
public type
  TIterator = record
  private
    Item: PItem;
  public 
    procedure Done; inline;
    function P: Pointer; inline;
    function Next: Boolean; inline;
  end;
  TOutIterator = record
  private
    Item: PItem;
    PseudoItem: TItem;
  public
    procedure Init(Graph: PGraph; P: Pointer); inline;
    procedure Init(const Graph: TGraph; P: Pointer); inline;
    procedure Done; inline;
    function P: Pointer; inline;
    function Next: Boolean; inline;
  end;
  TInIterator = record
  private
    Item: PItem;
    PseudoItem: TItem;
  public
    procedure Init(Graph: PGraph; P: Pointer); inline;
    procedure Init(const Graph: TGraph; P: Pointer); inline;
    procedure Done; inline;
    function P: Pointer; inline;
    function Next: Boolean; inline;
  end;
private
  FPage: PPage;
  FPageSize: SizeUInt;
  FOut: array[0 .. 255] of TTable;
  FIn: array[0 .. 255] of TTable;
  function FindOrLast(T: PTable; P: Pointer): PTable;
      // Finds in table item for the specified P or last.
public
  procedure Init(PageSize: SizeUInt);
  procedure Done;
  procedure Clear;
      // Clears and frees all data without destruction the object.
  procedure Add(P1, P2: Pointer);
      // Adds edge P1->P2.
  procedure DelOut(P: Pointer);
      // Deletes all output edges from P.
  procedure DelIn(P: Pointer);
      // Deletes all input edges from P.
end;

implementation

procedure TGraph.TIterator.Done;
begin
end;

function TGraph.TIterator.P: Pointer;
begin
  Result := Item^.Next;
end;

function TGraph.TIterator.Next: Boolean;
begin
  Item := Item^.Next;
  Result := Item <> nil;
end;

function PtrToIndex(P: Pointer): SizeUInt; inline;
      // Returns hash 0..255 of the specified pointer P.
begin
  Result := (PtrUInt(P) shr 4) and $ff;
end;

procedure TGraph.TOutIterator.Init(Graph: PGraph; P: Pointer);
var
  T: PTable;
begin
  T := @Graph^.FOut[PtrToIndex(P)];
  while T <> nil do begin
    if T^.P = P then begin
      PseudoItem.P := nil;
      PseudoItem.Next := T^.List;
    end;
    T := T^.Next;
  end;
  PseudoItem.P := nil;
  PseudoItem.Next := nil;
  Item := @PseudoItem;
end;

procedure TGraph.TOutIterator.Init(const Graph: TGraph; P: Pointer);
begin
  Init(@Graph, P);
end;

procedure TGraph.TOutIterator.Done;
begin
end;

function TGraph.TOutIterator.P: Pointer;
begin
  Result := Item^.P;
end;

function TGraph.TOutIterator.Next: Boolean;
begin
  Item := Item^.Next;
  Result := Item <> nil;
end;

procedure TGraph.TInIterator.Init(Graph: PGraph; P: Pointer);
var
  T: PTable;
begin
  T := @Graph^.FIn[PtrToIndex(P)];
  while T <> nil do begin
    if T^.P = P then begin
      PseudoItem.P := nil;
      PseudoItem.Next := T^.List;
      Item := @PseudoItem;
    end;
    T := T^.Next;
  end;
  PseudoItem.P := nil;
  PseudoItem.Next := nil;
  Item := @PseudoItem;
end;

procedure TGraph.TInIterator.Init(const Graph: TGraph; P: Pointer);
begin
  Init(@Graph, P);
end;

procedure TGraph.TInIterator.Done;
begin
end;

function TGraph.TInIterator.P: Pointer;
begin
  Result := Item^.P;
end;

function TGraph.TInIterator.Next: Boolean;
begin
  Item := Item^.Next;
  Result := Item <> nil;
end;

function TGraph.FindOrLast(T: PTable; P: Pointer): PTable;
begin
  while T^.Next <> nil do begin
    if T^.P = P then
      break;
    T := T^.Next;
  end;
  Result := T;
end;

procedure TGraph.Init(PageSize: SizeUInt);
begin
end;

procedure TGraph.Done;
begin
end;

procedure TGraph.Clear;
begin
end;

procedure TGraph.Add(P1, P2: Pointer);
var
  T: PTable;
begin
  T := FindOrLast(@FIn[PtrToIndex(P1)], P1);
end;

procedure TGraph.DelOut(P: Pointer);
begin
end;

procedure TGraph.DelIn(P: Pointer);
begin
end;

end.
