program SpeedTest;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  Winapi.Windows,
  System.Generics.Defaults,
  System.Generics.Collections,
  System.SysUtils,
  System.Classes;

type
  TStringEqualComparer = class(TInterfacedObject)
    function Equals(const Left, Right: string): Boolean; reintroduce;
    // важно! если сделать виртуальный метод - то скорость падает ~3 раза
    // function GetHashCode(const Value: string): Integer; reintroduce; virtual; abstract;
  end;
  TComparerClass = class of TStringEqualComparer;

  TSedgwicComparer = class(TStringEqualComparer, IEqualityComparer<string>)
    function GetHashCode(const Value: string): Integer; reintroduce;
  end;

  TSimpleComparer = class(TStringEqualComparer, IEqualityComparer<string>)
    function GetHashCode(const Value: string): Integer; reintroduce;
  end;

  TShiftComparer = class(TStringEqualComparer, IEqualityComparer<string>)
    function GetHashCode(const Value: string): Integer; reintroduce;
  end;

  TFastComparer = class(TStringEqualComparer, IEqualityComparer<string>)
    function GetHashCode(const Value: string): Integer; reintroduce;
  end;

{ TStringEqualComparer }

function TStringEqualComparer.Equals(const Left, Right: string): Boolean;
label
  cmp_ptrs;
var
  i, Count: NativeInt;
  S1, S2: PNativeUInt;
begin
  S1 := Pointer(Left);
  S2 := Pointer(Right);
  if (S1 <> S2) and (S1 <> nil) and (S2 <> nil) then
  begin
    Dec(NativeUInt(S1), SizeOf(Integer));
    Dec(NativeUInt(S2), SizeOf(Integer));
    Count := PInteger(S1)^;
    if (Integer(Count) <> PInteger(S2)^) then goto cmp_ptrs;
    Inc(NativeUInt(S1), SizeOf(Integer));
    Inc(NativeUInt(S2), SizeOf(Integer));

    for i := 1 to Count shr {$if SizeOf(NativeUInt) = 8}2{$else}1{$endif} do
    begin
      if (S1^ <> S2^) then goto cmp_ptrs;
      Inc(S1);
      Inc(S2);
    end;

    {$if SizeOf(NativeUInt) = 8}
    if (Count and 2 <> 0) then
    begin
      if (PCardinal(S1)^ <> PCardinal(S2)^) then goto cmp_ptrs;
      Inc(NativeUInt(S1), SizeOf(Cardinal));
      Inc(NativeUInt(S2), SizeOf(Cardinal));
    end;
    {$endif}

    if (PWord(S1)^ <> PWord(S2)^) then goto cmp_ptrs;
    Result := True;
    Exit;
  end else
  begin
  cmp_ptrs:
    Result := (S1 = S2);
  end;
end;

{ TSedgwicComparer }

function TSedgwicComparer.GetHashCode(const Value: string): Integer;
var
  a, i: Integer;
begin
  Result := 0;
  a := 63689;
  for i := 1 to Length(Value) - 1 do
  begin
    Result := Result * a + PWordArray(Value)[i];
    a := a * 378551;
  end;
end;

{ TSimpleComparer }

function TSimpleComparer.GetHashCode(const Value: string): Integer;
var
  i: NativeInt;
  S: PChar;
begin
  S := Pointer(Value);
  Result := 0;
  if (S <> nil) then
  begin
    Result := PInteger(NativeInt(Value) - 4)^;

    for i := 0 to NativeInt(Result) - 1 do
    begin
      Result := Result + Ord(S[i]);
    end;
  end;
end;

{ TShiftComparer }

function TShiftComparer.GetHashCode(const Value: string): Integer;
var
  i: NativeInt;
  S: PChar;
begin
  S := Pointer(Value);
  Result := 0;
  if (S <> nil) then
  begin
    Result := PInteger(NativeInt(Value) - 4)^;

    for i := 0 to NativeInt(Result) - 1 do
    begin
      Result := Result xor (Result shr (i and 7 + 1)) + Ord(S[i]);
    end;
  end;
end;

{ TFastComparer }

function TFastComparer.GetHashCode(const Value: string): Integer;
var
  i, X, Count: Integer;
  S: PByte;
begin
  S := Pointer(Value);
  Result := 0;
  if (S <> nil) then
  begin
    Count := PInteger(NativeInt(Value) - 4)^;

    Result := Count;
    for i := 1 to (Count shr (SizeOf(Char) xor 3)) do
    begin
      X := Result xor PInteger(S)^;
      Result := Result * i;
      Inc(Result, X shr 19);
      Inc(S, SizeOf(Integer));
      Inc(Result, X);
    end;

    for i := 1 to (Count and ((SizeOf(Char) xor 2) or 1)) do
    begin
      Result := Result * i;
      Inc(Result, Ord(PChar(S)^));
      Inc(S, SizeOf(Char));
    end;
  end;
end;


const
  ITERATIONS_COUNT = 1000000;
  COMPARERS: array[0..4] of TComparerClass = (nil, TSedgwicComparer, TSimpleComparer, TShiftComparer, TFastComparer);

var
  i, c, k: NativeInt;
  VALUES: TArray<string>;
  Time: Cardinal;
  Dictionary: TDictionary<string, Integer>;

begin
  VALUES := [
    'div',
    'span',
    'table',
    'td',
    'tr',
    'th',
    'li',
    'meta',
    'script',
    'style',
    'ol',
    'ul',
    'h1',
    'h2',
    'h3',
    'h4',
    'h5',
    'thead',
    'tbody',
    'html',
    'body',
    'blockquote',
    'address',
    'frame',
    'frameset',
    'pre',
    'button',
    'textarea',
    'strike',
    'del',
    'menu',
    'small',
    'sub',
    'sup',
    'img',
    'fieldset',
    'legend'
  ];

  try
    // цикл по всем компарерам
    for c := Low(COMPARERS) to High(COMPARERS) do
    begin
      // конструктор, инфо
      if (COMPARERS[c] = nil) then
      begin
        Write('Default', '...');
        Dictionary := TDictionary<string, Integer>.Create;
      end else
      begin
        Write(COMPARERS[c].ClassName, '...');
        case c of
          1: Dictionary := TDictionary<string, Integer>.Create(TSedgwicComparer.Create);
          2: Dictionary := TDictionary<string, Integer>.Create(TSimpleComparer.Create);
          3: Dictionary := TDictionary<string, Integer>.Create(TShiftComparer.Create);
        else
          // 4:
          Dictionary := TDictionary<string, Integer>.Create(TFastComparer.Create);
        end;
      end;

      try
        // заполняем
        for k := Low(VALUES) to High(VALUES) do
          Dictionary.Add(VALUES[k], 0);

        // тестируем
        Time := GetTickCount;
        for i := 1 to ITERATIONS_COUNT do
        for k := Low(VALUES) to High(VALUES) do
        begin
          Dictionary.Items[VALUES[k]];
        end;
        Time := GetTickCount - Time;
        Writeln(' ', Time, 'мс');

      finally
        Dictionary.Free;
      end;
    end;
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;

  // нажать Enter
  Writeln;
  Write('Press Enter');
  Readln;
end.