delphi Stack

TValueType = (vtInteger, vtFloat, vtBoolean, vtString, vtNone, vtMethod);

  TValue = record
    CurType: TValueType;
    I: Integer;
    F: Double;
    B: Boolean;
    S: string;
  end;

TStack = class(TObject)
  private
    FBuf: TMemoryStream;
    procedure Push_(const Value; Size: Integer);
    procedure Pop_(var Value; Size: Integer);
    procedure PushType(T: TValueType);
    procedure PopType;
    function GetBLen: Integer;
    procedure SetBLen(i: Integer);
  public
    constructor Create;
    destructor Destroy; override;
    function IsEmpty: Boolean;
    procedure PushI(Value: Integer);
    procedure PushF(Value: Double);
    procedure PushB(Value: Boolean);
    procedure PushS(Value: string);
    function PopI: Integer;
    function PopF: Double;
    function PopB: Boolean;
    function PopS: string;
    procedure Push(Value: TValue);
    procedure Pop(var Value: TValue);
    procedure Clear;
    property BLen: Integer read GetBLen write SetBLen;
    function Dump: string; //Clears all stack
    function WhatIs: TValueType;
  end;


implementation


function TStack.GetBLen: Integer;
begin
  result := FBuf.Position;
end;


procedure TStack.SetBLen(i: Integer);
begin
  FBuf.SetSize(i);
end;


procedure TStack.Push_(const Value; Size: Integer);
begin
  if Size < 0 then
  begin
    raise Exception.Create('Invalid Data size');
  end;
  FBuf.Write(Value, Size);
end;


procedure TStack.Pop_(var Value; Size: Integer);
begin
  if (Size < 0) or (Size > FBuf.Position) then
  begin
    raise Exception.Create('Invalid stack size');
  end;
  FBuf.Position := FBuf.Position - Size;
  FBuf.Read(Value, Size);
  FBuf.Position := FBuf.Position - Size;
end;


procedure TStack.PushType(T: TValueType);
begin
  Push_(T, 1);
end;


procedure TStack.PopType;
var
  T: TValueType;
begin
  Pop_(T, 1);
end;


constructor TStack.Create;
begin
  inherited;
  FBuf := TMemoryStream.Create;
end;


destructor TStack.Destroy;
begin
  FBuf.Free;
  inherited;
end;


function TStack.WhatIs: TValueType;
var
  VT: TValueType;
begin
  if IsEmpty then
  begin
    Result := vtNone
  end
  else
  begin
    Pop_(VT, SizeOf(TValueType));
    Result := VT;
    PushType(VT);
  end;
end;


function TStack.IsEmpty: Boolean;
begin
  result := FBuf.Position = 0;
end;


procedure TStack.PushI(Value: Integer);
begin
  Push_(Value, SizeOf(Value));
  PushType(vtInteger);
end;


procedure TStack.PushF(Value: Double);
begin
  Push_(Value, SizeOf(Value));
  PushType(vtFloat);
end;


procedure TStack.PushB(Value: Boolean);
begin
  Push_(Value, SizeOf(Value));
  PushType(vtBoolean);
end;


procedure TStack.PushS(Value: string);
var
  i: Integer;
begin
  i := Length(Value);
  if i > 0 then Push_(Value[1], Length(Value));
  Push_(i, SizeOf(i));
  PushType(vtString);
end;


function TStack.PopI: Integer;
begin
  if WhatIs <> vtInteger then
    raise Exception.Create('Attempt to Pop wrong type');
  PopType;
  Pop_(result, SizeOf(result));
end;


function TStack.PopF: Double;
begin
  if WhatIs <> vtFloat then
    raise Exception.Create('Attempt to Pop wrong type');
  PopType;
  Pop_(result, SizeOf(result));
end;


function TStack.PopB: Boolean;
begin
  if WhatIs <> vtBoolean then
    raise Exception.Create('Attempt to Pop wrong type');
  PopType;
  Pop_(result, SizeOf(result));
end;


function TStack.PopS: string;
var
  i: Integer;
begin
  if WhatIs <> vtString then
    raise Exception.Create('Attempt to Pop wrong type');
  PopType;
  Pop_(i, SizeOf(i));
  SetLength(result, i);
  Pop_(result[1], i);
end;


procedure TStack.Push(Value: TValue);
begin
  with Value do
  begin
    case CurType of
      vtInteger: PushI(I);
      vtFloat: PushF(F);
      vtBoolean: PushB(B);
      vtString: PushS(S);
    end;
  end;
end;


procedure TStack.Pop(var Value: TValue);
begin
  with Value do
  begin
    CurType := WhatIs;
    case CurType of
      vtInteger: I := PopI;
      vtFloat: F := PopF;
      vtBoolean: B := PopB;
      vtString: S := PopS;
    end;
  end;
end;


procedure TStack.Clear;
begin
  FBuf.Position := 0;
end;


function TStack.Dump: string;


function BoolToStr(B: Boolean): string;
  begin
    if B then
      result := 'True'
    else
      result := 'False';
  end;
begin
  result := '';
  if IsEmpty then Result := 'Empty stack';
  while not IsEmpty do
  begin
    case WhatIs of
      vtInteger: result := result + 'Integer=' + IntToStr(PopI);
      vtFloat: result := result + 'Float=' + FloatToStr(PopF);
      vtBoolean: result := result + 'Boolean=' + BoolToStr(PopB);
      vtString: result := result + 'String="' + PopS + '"';
    end;
    if not IsEmpty then result := result + #13#10;
  end;
end;