unit dnodeview;

//
//  Read-only access to arbitrary structured data.
//

{$MODE FPC}
{$MODESWITCH ADVANCEDRECORDS}
{$MODESWITCH DEFAULTPARAMETERS}
{$MODESWITCH OUT}
{$MODESWITCH RESULT}

interface

const
  NODE_NULL     = 0;
  NODE_INT      = 1;
  NODE_FLOAT    = 2;
  NODE_STRING   = 3;
  NODE_BOOLEAN  = 4;
  NODE_ARRAY    = 5;
  NODE_HASHMAP  = 6;
  NODE_LIST     = 7;

  // Declare your own types as NODE_USERDATA+i, 0<=i<=127
  NODE_USERDATA = 128;

type
PNodeView = ^TNodeView;
PNodePair = ^TNodePair;
PNodeList = ^TNodeList;
PNodeBucket = ^TNodeBucket;
PNodeViewHashMap = ^TNodeViewHashMap;
PNodeViewArray = ^TNodeViewArray;

TNodeInt = PtrInt;
TNodeBoolean = Boolean;
TNodeFloat = {$IF SizeOf(Pointer) >= SizeOf(Double)} Double
             {$ELSE} Single {$ENDIF};
TNodeCount = SizeUInt;
TNodeHash = PtrUInt;

TNodeHashedString = packed record
  S: PAnsiChar;
  Len: SizeUInt;
  Hash: TNodeHash;
  procedure SetValue(Value, ValueEnd: PAnsiChar);
  procedure SetValue(Value: PAnsiChar; ValueLen: SizeUInt);
  procedure SetValue(Value: PAnsiChar);
  procedure SetValueHashed(Value, ValueEnd: PAnsiChar; aHash: TNodeHash);
  procedure SetValueHashed(Value: PAnsiChar; ValueLen: SizeUInt; aHash: TNodeHash);
  procedure SetValueHashed(Value: PAnsiChar; aHash: TNodeHash);
end;

TNodeView = packed record
  procedure MakeHeader(aType: PtrUInt; aCount: TNodeCount); inline;
  function _Type: PtrUInt; inline;
  function GetCount: TNodeCount; inline;
  procedure SetCount(NewCount: TNodeCount); inline;
  procedure SetNull;
  procedure SetInt(Value: TNodeInt);
  procedure SetFloat(Value: TNodeFloat);
  procedure SetString(SBegin, SEnd: PAnsiChar); overload;
  procedure SetString(SBegin: PAnsiChar; SLen: TNodeCount); overload;
  procedure SetString(SNullTerminated: PAnsiChar); overload;
  procedure SetBoolean(Value: TNodeBoolean);
  procedure SetArray(ABegin: PNodeView; ALen: TNodeCount);
  procedure SetHashmap(Buckets: PNodeBucket; BucketsCount: TNodeCount);
  procedure SetUserData(aType: PtrUInt; aCount: TNodeCount; UserData: Pointer);

  function GetInt(Def: TNodeInt): TNodeInt; overload;
  function GetFloat(Def: TNodeFloat): TNodeFloat;
  function GetBoolean(Def: TNodeBoolean): TNodeBoolean;
  function ToInt: TNodeInt;

  // for NODE_HASHMAP only
  procedure PushPair(Pair: PNodePair);
  function FindPair(const Key: TNodeHashedString;
                    out Node: TNodeView): Boolean;
  function GetInt(const Key: TNodeHashedString;
                  Def: TNodeInt): TNodeInt; overload;
  function GetArr(const Key: TNodeHashedString;
                  Def: PNodeViewArray): PNodeViewArray;

  property Count: TNodeCount read GetCount write SetCount;
public
  Header: PtrUInt;
case Byte of
  NODE_NULL:     (Data: Pointer);
  NODE_INT:      (I: TNodeInt);
  NODE_FLOAT:    (F: TNodeFloat);
  NODE_BOOLEAN:  (B: TNodeBoolean);
  NODE_STRING:   (S: PAnsiChar);
  NODE_ARRAY:    (A: PNodeView);
  NODE_HASHMAP:  (H: PNodeBucket);
  NODE_LIST:     (L: PNodeList);
  NODE_USERDATA: (U: Pointer);
end;

// Check that the size of the record is expected
{$IF (SizeOf(TNodeView) > 2 * SizeOf(Pointer)) or
     (SizeOf(TNodeView) > 2 * SizeOf(PtrUInt))}
  {$ERROR TNodeView is too large (fix the record declaration or comment the error)}
{$ENDIF}

TNodeViewHashMap = TNodeView;
TNodeViewArray = TNodeView;

TNodeList = packed record
  Value: TNodeView;
  Next: PNodeList;
end;

TNodePair = packed record
  Value: TNodeView;
  Key: TNodeHashedString;
  Next: PNodePair;
  procedure SetNull(KeyBegin, KeyEnd: PAnsiChar); overload;
  procedure SetNull(KeyNullTerminated: PAnsiChar); overload;
  procedure SetInt(KeyBegin, KeyEnd: PAnsiChar; I: TNodeInt); overload;
  procedure SetInt(KeyNullTerminated: PAnsiChar; I: TNodeInt); overload;
  procedure SetFloat(KeyBegin, KeyEnd: PAnsiChar; F: TNodeFloat); overload;
  procedure SetFloat(KeyNullTerminated: PAnsiChar; F: TNodeFloat); overload;
  procedure SetBoolean(KeyBegin, KeyEnd: PAnsiChar; B: TNodeBoolean); overload;
  procedure SetBoolean(KeyNullTerminated: PAnsiChar; B: TNodeBoolean); overload;
  procedure SetString(KeyBegin, KeyEnd, S, SEnd: PAnsiChar); overload;
  procedure SetString(KeyNullTerminated, S, SEnd: PAnsiChar); overload;
end;

TNodeBucket = record
  First: PNodePair;
  procedure SetEmpty;
  procedure Push(Pair: PNodePair);
end;

function NodeHash(Data, DataEnd: PAnsiChar): TNodeHash; inline; overload;
function NodeHash(Data: PAnsiChar; DataLen: SizeUInt): TNodeHash; inline; overload;

operator := (S: PAnsiChar): TNodeHashedString;
operator := (const S: AnsiString): TNodeHashedString;

implementation

procedure TNodeHashedString.SetValue(Value, ValueEnd: PAnsiChar);
begin
  S := Value;
  Len := ValueEnd - Value;
  Hash := NodeHash(S, Len);
end;

procedure TNodeHashedString.SetValue(Value: PAnsiChar; ValueLen: SizeUInt);
begin
  S := Value;
  Len := ValueLen;
  Hash := NodeHash(S, Len);
end;

procedure TNodeHashedString.SetValue(Value: PAnsiChar);
begin
  S := Value;
  Len := StrLen(Value);
  Hash := NodeHash(Value, Len);
end;

procedure TNodeHashedString.SetValueHashed(Value, ValueEnd: PAnsiChar; aHash: TNodeHash);
begin
  S := Value;
  Len := ValueEnd - Value;
  Hash := aHash;
end;

procedure TNodeHashedString.SetValueHashed(Value: PAnsiChar; aHash: TNodeHash);
begin
  S := Value;
  Len := StrLen(Value);
  Hash := aHash;
end;

procedure TNodeHashedString.SetValueHashed(Value: PAnsiChar; ValueLen: SizeUInt; aHash: TNodeHash);
begin
  S := Value;
  Len := ValueLen;
  Hash := aHash;
end;

procedure TNodeView.MakeHeader(aType: PtrUInt; aCount: TNodeCount);
begin
  Header := (aCount shl 8) or (aType and $ff);
end;

function TNodeView._Type: PtrUInt;
begin
  Exit(Header and $ff);
end;

function TNodeView.GetCount: TNodeCount;
begin
  Exit(Header shr 8);
end;

procedure TNodeView.SetCount(NewCount: TNodeCount);
begin
  Header := (Header and $ff) or (NewCount shl 8);
end;

procedure TNodeView.SetNull;
begin
  Header := NODE_NULL;
end;

procedure TNodeView.SetInt(Value: TNodeInt);
begin
  Header := NODE_INT;
  I := Value;
end;

procedure TNodeView.SetFloat(Value: TNodeFloat);
begin
  Header := NODE_FLOAT;
  F := Value;
end;

procedure TNodeView.SetString(SBegin, SEnd: PAnsiChar);
begin
  Header := NODE_STRING or ((SEnd - SBegin) shl 8);
  S := SBegin;
end;

procedure TNodeView.SetString(SBegin: PAnsiChar; SLen: TNodeCount);
begin
  Header := NODE_STRING or (SLen shl 8);
  S := SBegin;
end;

procedure TNodeView.SetString(SNullTerminated: PAnsiChar);
begin
  Header := NODE_STRING or (StrLen(SNullTerminated) shl 8);
  S := SNullTerminated;
end;

procedure TNodeView.SetBoolean(Value: TNodeBoolean);
begin
  Header := NODE_BOOLEAN;
  B := Value;
end;

procedure TNodeView.SetArray(ABegin: PNodeView; ALen: TNodeCount);
begin
  Header := NODE_ARRAY or (ALen shl 8);
  A := ABegin;
end;

procedure TNodeView.SetHashmap(Buckets: PNodeBucket; BucketsCount: TNodeCount);
begin
  Header := NODE_HASHMAP or (BucketsCount shl 8);
  H := Buckets;
end;

procedure TNodeView.SetUserData(aType: PtrUInt; aCount: TNodeCount; UserData: Pointer);
begin
  MakeHeader(aType, aCount);
  U := UserData;
end;

function TNodeView.GetInt(Def: TNodeInt): TNodeInt;
begin
  if Header = NODE_INT then begin
    Exit(I);
  end else
    Exit(Def);
end;

function TNodeView.GetFloat(Def: TNodeFloat): TNodeFloat;
begin
  if Header = NODE_FLOAT then begin
    Exit(F);
  end else
    Exit(Def);
end;

function TNodeView.GetBoolean(Def: TNodeBoolean): TNodeBoolean;
begin
  if Header = NODE_BOOLEAN then begin
    Exit(B);
  end else
    Exit(Def);
end;

function TNodeView.ToInt: TNodeInt;
begin
  case _Type of
  NODE_INT: Exit(I);
  NODE_FLOAT: Exit(Round(F));
  NODE_BOOLEAN: Exit(Ord(B));
  else
    Exit(0);
  end;
end;

procedure TNodeView.PushPair(Pair: PNodePair);
begin
  if Count = 0 then begin
    Pair^.Next := PNodePair(H);
    PNodePair(H) := Pair;
  end else
    H[Pair^.Key.Hash mod Count].Push(Pair);
end;

function TNodeView.FindPair(const Key: TNodeHashedString;
              out Node: TNodeView): Boolean;
var
  Bucket: PNodeBucket;
  It: PNodePair;
begin
  if Count = 0 then begin
    It := PNodePair(H);
    while It <> nil do begin
      if (It^.Key.Len = Key.Len) and
         (CompareByte(It^.Key.S^, Key.S^, Key.Len) = 0) then begin
        Node := It^.Value;
        Exit(True);
      end;
      It := It^.Next;
    end;
  end else begin
    Bucket := H + (Key.Hash mod Count);
    It := Bucket^.First;
    while It <> nil do begin
      if (It^.Key.Hash = Key.Hash) and
         (It^.Key.Len = Key.Len) and
         (CompareByte(It^.Key.S^, Key.S^, Key.Len) = 0) then begin
        Node := It^.Value;
        Exit(True);
      end;
      It := It^.Next;
    end;
  end;
  Exit(False);
end;

function TNodeView.GetInt(const Key: TNodeHashedString;
                Def: TNodeInt): TNodeInt;
var
  N: TNodeView;
begin
  if not FindPair(Key, N) then
    Exit(Def);
  Exit(N.GetInt(Def));
end;

function TNodeView.GetArr(const Key: TNodeHashedString;
                Def: PNodeViewArray): PNodeViewArray;
var
  N: TNodeView;
begin
  if not FindPair(Key, N) then
    Exit(Def);
  if not N._Type = NODE_ARRAY then
    Exit(Def);
  Exit(@N);
end;

function _NodeHash(Data, DataEnd: PAnsiChar; Hash: TNodeHash): TNodeHash;
begin
  // TODO try to unroll this loop and measure performance
  while Data < DataEnd do begin
    Hash := ((Hash shl 5) + Hash) + Ord(Data^); // hash * 33 + c
    Inc(Data);
  end;
  Exit(Hash);
end;

procedure TNodePair.SetNull(KeyBegin, KeyEnd: PAnsiChar);
begin
  Value.SetNull;
  Key.SetValue(KeyBegin, KeyEnd);
end;

procedure TNodePair.SetNull(KeyNullTerminated: PAnsiChar); overload;
begin
  Value.SetNull;
  Key.SetValue(KeyNullTerminated);
end;

procedure TNodePair.SetInt(KeyBegin, KeyEnd: PAnsiChar; I: TNodeInt);
begin
  Value.SetInt(I);
  Key.SetValue(KeyBegin, KeyEnd);
end;

procedure TNodePair.SetInt(KeyNullTerminated: PAnsiChar; I: TNodeInt);
begin
  Value.SetInt(I);
  Key.SetValue(KeyNullTerminated);
end;

procedure TNodePair.SetFloat(KeyBegin, KeyEnd: PAnsiChar; F: TNodeFloat);
begin
  Value.SetFloat(F);
  Key.SetValue(KeyBegin, KeyEnd);
end;

procedure TNodePair.SetFloat(KeyNullTerminated: PAnsiChar; F: TNodeFloat);
begin
  Value.SetFloat(F);
  Key.SetValue(KeyNullTerminated);
end;

procedure TNodePair.SetBoolean(KeyBegin, KeyEnd: PAnsiChar; B: TNodeBoolean);
begin
  Value.SetBoolean(B);
  Key.SetValue(KeyBegin, KeyEnd);
end;

procedure TNodePair.SetBoolean(KeyNullTerminated: PAnsiChar; B: TNodeBoolean);
begin
  Value.SetBoolean(B);
  Key.SetValue(KeyNullTerminated);
end;

procedure TNodePair.SetString(KeyBegin, KeyEnd, S, SEnd: PAnsiChar);
begin
  Value.SetString(S, SEnd);
  Key.SetValue(KeyBegin, KeyEnd);
end;

procedure TNodePair.SetString(KeyNullTerminated, S, SEnd: PAnsiChar);
begin
  Value.SetString(S, SEnd);
  Key.SetValue(KeyNullTerminated);
end;

procedure TNodeBucket.SetEmpty;
begin
  First := nil;
end;

procedure TNodeBucket.Push(Pair: PNodePair);
begin
  Pair^.Next := First;
  First := Pair;
end;

function NodeHash(Data, DataEnd: PAnsiChar): TNodeHash;
begin
  Exit(_NodeHash(Data, DataEnd, 5381));
end;

function NodeHash(Data: PAnsiChar; DataLen: SizeUInt): TNodeHash; inline; overload;
begin
  Exit(_NodeHash(Data, Data + DataLen, 5381));
end;

operator := (S: PAnsiChar): TNodeHashedString;
begin
  Result.SetValue(S);
end;

operator := (const S: AnsiString): TNodeHashedString;
begin
  Result.SetValue(@S[1], @S[1] + Length(S));
end;

end.
