Скачиваний:
12
Добавлен:
01.05.2014
Размер:
4 Кб
Скачать
☆
{
  C-like language compiler v0.1.0.485

  12 november 2007

  Copyright (C) 2006, 2007 Igor Krooshch
  rheo.ikro@gmail.com

  This program is free software; you can redistribute it and/or
  modify it under the terms of the GNU Lesser General Public
  License as published by the Free Software Foundation; either
  version 2.1 of the License, or (at your option) any later version.

  This program is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  Lesser General Public License for more details.

  You should have received a copy of the GNU Lesser General Public
  License along with this library; if not, write to the Free Software
  Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
}

unit UCcBuffer;

interface

uses
  SysUtils, Classes;

type
  TCcPosition = record
    Line: integer;
    Offset: integer;
  end;


  ECcBufferException = class(Exception)
  private
    FPosition: TCcPosition;
  public
    constructor Create(const AMsg: string; APos: TCcPosition); reintroduce;
    function Position: TCcPosition;
  end;

  ECcBufferExceptionClass = class of ECcBufferException;


  TCcBuffer = class
  private
    FLastChar: char;
    FLastPosition: TCcPosition;
    FPosition: TCcPosition;
    FStream: TStream;
    FBuffer: string;
    FBufferSize: integer;
    FBufferPos: integer;
  public
    constructor Create(AStream: TStream; const ABufferSize: byte = 2);

    procedure CheckEof(A: char);

    procedure Error(const AMsg: string); overload;
    procedure Error(
      const AMsg: string; AErrClass: ECcBufferExceptionClass); overload;

    function GetChar: char;
    procedure UngetChar;

    property Position: TCcPosition read FPosition;
  end;


  function CcPosition(ALine, APos: integer): TCcPosition;

implementation

uses
  UCcTokenizerConsts;


function CcPosition(ALine, APos: integer): TCcPosition;
begin
  Result.Line := ALine;
  Result.Offset := APos;
end;


{ ECcBufferException }

constructor ECcBufferException.Create(
  const AMsg: string; APos: TCcPosition);
begin
  FPosition := APos;
  inherited CreateFmt(SCcErrorPrefix + AMsg, [APos.Line, APos.Offset]);
end;


function ECcBufferException.Position: TCcPosition;
begin
  Result := FPosition;
end;


{ TCcBuffer }

procedure TCcBuffer.CheckEof(A: char);
begin
  if A = #0 then
    Error(SCcTokenUnexpectedEOFError);
end;


constructor TCcBuffer.Create(AStream: TStream; const ABufferSize: byte);
var
  pc: PChar;
  sz: integer;
begin
  FBuffer := '';
  FBufferPos := 0;
  FBufferSize := ABufferSize;
  FStream := AStream;
  FLastChar := #0;

  FPosition.Line := 1;
  FPosition.Offset := 0;

  FLastPosition := FPosition;

  pc := nil;
  try
    sz := ABufferSize * sizeof(char);
    GetMem(pc, sz);
    sz := FStream.Read(pc^, sz) div sizeof(char);
    if sz > 0 then
      FBuffer := FBuffer + Copy(pc, 1, sz);
  finally
    FreeMem(pc);
  end;
end;


procedure TCcBuffer.Error(const AMsg: string);
begin
  Error(AMsg, ECcBufferException);
end;


procedure TCcBuffer.Error(
  const AMsg: string; AErrClass: ECcBufferExceptionClass);
begin
  raise AErrClass.Create(AMsg, FPosition);
end;


function TCcBuffer.GetChar: char;
var
  c: char;
begin
  Result := #0;
  try
    FLastPosition := FPosition;
    Inc(FBufferPos);
    if (FBufferPos > Length(FBuffer)) then begin
      Delete(FBuffer, 1, 1);
      if (FStream.Read(c, 1) = 0) then
        Exit
      else
        FBuffer := FBuffer + c;
      Dec(FBufferPos);
    end;
    Result := FBuffer[FBufferPos];
    if (FLastChar in [#13]) then begin
      Inc(FPosition.Line);
      FPosition.Offset := 1;
    end
    else
      Inc(FPosition.Offset);
  finally
    FLastChar := Result;
  end;
end;


procedure TCcBuffer.UngetChar;
begin
  if (FLastChar <> #0) and (FBufferPos > 0) then begin
    Dec(FBufferPos);
    Dec(FPosition.Offset);
  end;
end;


end.
 
Соседние файлы в папке Tokenizer