unit dtokenizer;

interface

uses
  dstrings,
  dstrnum,
  dstream;

const
  TOKEN_NO          = 0;
  TOKEN_SPACE       = 1;
  TOKEN_NUMBER      = 2;
  TOKEN_SYMBOL      = 3;
  TOKEN_WORD        = 4;

type
TCharPredicate = function (C: AnsiChar): Boolean;

TToken = record
  Typ: LongInt;
  Value: AnsiString;
end;

// TODO linenum, linepos
PTokenizer = ^TTokenizer;
TTokenizer = object
private
  FData: TData;
  FStream: PStream;
  FType: LongInt;
  FChar: AnsiChar;
  FToken: AnsiString;
  procedure NextChar; inline;
  function TryToken(T: LongInt; First, Predicate: TCharPredicate): Boolean;
public
  constructor Init(Data: TData);
  procedure Done;
  function Next: Boolean;
  procedure SkipSpaces;
  procedure Dump;
  function AsToken: TToken;
  property Typ: LongInt read FType;
  property Token: AnsiString read FToken;
  property Stream: PStream read FStream;
end;

TLookupReader = object
private
  FPos: LongInt;
  FLine: LongInt;
  FLookup: Byte;
  FData: TData;
public
  procedure Init(Data: TData);
  procedure Done;
  function NextChar: Boolean;
  function SkipSpaces: Boolean;
  function Match(C: AnsiChar): Boolean;
  property Pos: LongInt read FPos;
  property Line: LongInt read FLine;
  property Lookup: Byte read FLookup;
end;

TLineReader = object
public type
  TIdentsDiff = (
    IDENTS_SAME,
    IDENTS_LESS,
    IDENTS_MORE,
    IDENTS_ERROR
  );
private
  FCursor, FSourceEnd: PAnsiChar;
  FSource: PAnsiChar;
  FLineStart: PAnsiChar;
  FLine: LongInt;
  FIdents: LongInt;
  FIdentsWord: TAnsiView;
  FIdentsDiff: TIdentsDiff;
  function ComputePos: LongInt;
  // TAB is 2 spaces
  function SkipIdents: LongInt;
  function SkipToNewLine(out Rest: TAnsiView): Boolean;
public
  procedure Init(Source, SourceEnd: PAnsiChar);
  procedure Done;
  function Eof: Boolean;
  // #0 for Eof
  function NextChar: AnsiChar;
  // NextLine
  //
  //     1. Skip all chars to first newline symbol
  //     2. Skip all spaces, newlines and comments to first non-empty line
  //     3. Compare idents of current line and previouse non-empty
  //
  // Returns:
  //
  //     True: success, cursor points to non-empty character
  //     False: failed, one of the following happened
  //       1. Eof reached, Eof=True
  //       2. Idents are not matched, IdentsDiff=IDENTS_ERROR
  //
  //     Line: ending of previouse non-empty line
  function NextLine: Boolean; overload;
  function NextLine(out Line: TAnsiView): Boolean; overload;
  // 32 and 9
  function SkipSpaces: Boolean;
  function ReadNextWord(out W: TAnsiView): Boolean;
  function ReadString(out W: TAnsiView): Boolean;
  function ReadInt(out I: Int64): Boolean;
  // 0 - error, 1 - int, 2 - float
  function ReadIntOrDouble(out I: Int64; out F: Double): LongInt;
  procedure Advance(Delta: LongInt);
  property Cursor: PAnsiChar read FCursor;
  property Source: PAnsiChar read FSource;
  property SourceEnd: PAnsiChar read FSourceEnd;
  property Pos: LongInt read ComputePos;
  property Line: LongInt read FLine;
  property Idents: LongInt read FIdents;
  property IdentsDiff: TIdentsDiff read FIdentsDiff;
end;

function IsCharSpace(C: AnsiChar): Boolean; inline;
function IsCharDecimal(C: AnsiChar): Boolean; inline;
function IsCharHex(C: AnsiChar): Boolean; inline;
function IsCharLetter(C: AnsiChar): Boolean; inline;
function IsCharAlphaNum(C: AnsiChar): Boolean; inline;

implementation

procedure TTokenizer.NextChar;
begin
  if not FStream.Eof then begin
    FChar := AnsiChar(FStream.ReadByte);
  end else
    FChar := #0;
end;

function TTokenizer.TryToken(T: LongInt; First, Predicate: TCharPredicate): Boolean;
begin
  Result := First(FChar);
  if Result then begin
    FType := T;
    repeat
      FToken := FToken + FChar;
      if not FStream.Eof then begin
        FChar := AnsiChar(FStream.ReadByte);
      end else begin
        FChar := #0;
        Exit;
      end;
    until not Predicate(FChar);
  end;
end;

constructor TTokenizer.Init(Data: TData);
begin
  FData := Data;
  FStream := FData.Stream;
  FType := TOKEN_NO;
  NextChar;
end;

procedure TTokenizer.Done;
begin
  FData.Done;
end;

function IsCharSpace(C: AnsiChar): Boolean;
begin
  Result := Ord(C) <= 32;
end;

function IsCharDecimal(C: AnsiChar): Boolean;
begin
  Result := ('0' <= C) and (C <= '9');
end;

function IsCharHex(C: AnsiChar): Boolean;
begin
  Result := IsCharDecimal(C) or (('a' <= C) and (C <= 'f'))
                             or (('A' <= C) and (C <= 'F'));
end;

function IsCharLetter(C: AnsiChar): Boolean;
begin
  Result := (('a' <= C) and (C <= 'z')) or (('A' <= C) and (C <= 'Z'));
end;

function IsCharAlphaNum(C: AnsiChar): Boolean; inline;
begin
  Result := IsCharLetter(C) or IsCharDecimal(C);
end;

function TTokenizer.Next: Boolean;
begin
  if FStream.Eof then begin
    FType := TOKEN_NO;
    Exit(False);
  end;
  FToken := '';
  repeat
    if TryToken(TOKEN_SPACE, @IsCharSpace, @IsCharSpace) then
      Break;
    if TryToken(TOKEN_WORD, @IsCharLetter, @IsCharAlphaNum) then
      Break;
    if TryToken(TOKEN_NUMBER, @IsCharDecimal, @IsCharHex) then
      Break;
    FType := TOKEN_SYMBOL;
    FToken := FChar;
    NextChar;
  until True;
  Exit(True);
end;

procedure TTokenizer.SkipSpaces;
begin
  while FType = TOKEN_SPACE do
    Next;
end;

procedure TTokenizer.Dump;
var
  C: AnsiChar;
begin
  if (FType = TOKEN_NO) and FStream.Eof then begin
    Writeln('EOF');
    Exit;
  end;
  case FType of
    TOKEN_NO: Writeln('NO');
    TOKEN_SPACE: begin
      Write('SPACE'#9);
      for C in FToken do
        Write('#', IntToHex(Ord(C), 2));
      Writeln;
    end;
    TOKEN_NUMBER: Writeln('NUMBER'#9, FToken);
    TOKEN_SYMBOL: Writeln('SYMBOL'#9, FToken);
    TOKEN_WORD: Writeln('WORD'#9, FToken);
  else
    Writeln('UNKNOWN');
  end;
end;

function TTokenizer.AsToken: TToken;
begin
  Result.Typ := Typ;
  Result.Value := Token;
end;

procedure TLookupReader.Init(Data: TData);
begin
  FData := Data;
  FPos := 0;
  FLine := 1;
  FLookup := 0;
end;

procedure TLookupReader.Done;
begin
  FData.Done;
end;

function TLookupReader.NextChar: Boolean;
begin
  Result := not FData.Stream^.Eof;
  if Result then begin
    if (FLookup = 13) or (FLookup = 10) then begin
      FPos := 1;
      Inc(FLine);
      if FLookup = 13 then begin
        FLookup := FData.Stream^.ReadByte;
        if FLookup = 10 then begin
          Result := not FData.Stream^.Eof;
          if Result then
            FLookup := FData.Stream^.ReadByte;
        end;
      end else
        FLookup := FData.Stream^.ReadByte;
    end else begin
      FLookup := FData.Stream^.ReadByte;
      Inc(FPos);
    end;
  end else
    FLookup := 0;
end;

function TLookupReader.SkipSpaces: Boolean;
begin
  while IsCharSpace(AnsiChar(FLookup)) do begin
    if not NextChar then
      Exit(False);
  end;
  Exit(True);
end;

function TLookupReader.Match(C: AnsiChar): Boolean;
begin
  Result := AnsiChar(FLookup) = C;
  if Result then
    NextChar;
end;

function TLineReader.ComputePos: LongInt;
var
  I: PAnsiChar;
begin
  Result := 1;
  I := FLineStart;
  while I < FCursor do begin
    // TODO read utf-8
    Inc(I);
    Inc(Result);
  end;
end;

function TLineReader.SkipIdents: LongInt;
begin
  Result := 0;
  while True do begin
    if FCursor >= FSourceEnd then
      Exit;
    if FCursor^ = #32 then begin
      Inc(Result, 1);
    end else if FCursor^ = #9 then begin
      Inc(Result, 2);
    end else
      Exit;
    Inc(FCursor);
  end;
end;

function TLineReader.SkipToNewLine(out Rest: TAnsiView): Boolean;
begin
  Rest.Data := FCursor;
  Inc(FLine);
  while True do begin
    Rest.Length := FCursor - Rest.Data; // TODO do not do it every cycle
    if FCursor^ = #10 then begin
      Inc(FCursor);
      FLineStart := FCursor;
      Exit(FCursor < FSourceEnd);
    end;
    if (FCursor^ = #13) then begin
      Inc(FCursor);
      if FCursor >= FSourceEnd then
        Exit(False);
      if FCursor^ = #10 then begin
        Inc(FCursor);
        FLineStart := FCursor;
        Exit(FCursor < FSourceEnd);
      end else begin
        FLineStart := FCursor;
        Exit(True);
      end;
    end;
    Inc(FCursor);
    if FCursor >= FSourceEnd then
      Exit(False);
  end;
end;

procedure TLineReader.Init(Source, SourceEnd: PAnsiChar);
begin
  FCursor := Source;
  FSourceEnd := SourceEnd;
  FSource := Source;
  FLineStart := FCursor;
  FLine := 1;
  FIdents := SkipIdents;
end;

procedure TLineReader.Done;
begin
end;

function TLineReader.Eof: Boolean;
begin
  Result := FCursor >= FSourceEnd;
end;

function TLineReader.NextChar: AnsiChar;
begin
  if Eof then
    Exit(#0);
  Result := FCursor^;
  Inc(FCursor);
end;

function TLineReader.NextLine: Boolean;
var
  Temp: TAnsiView;
begin
  Result := NextLine(Temp);
end;

function TLineReader.NextLine(out Line: TAnsiView): Boolean;
begin
  Result := SkipToNewLine(Line);
  if Result then begin
    FIdents := SkipIdents;
  end;
end;

function TLineReader.SkipSpaces: Boolean;
begin
  while True do begin
    if FCursor >= FSourceEnd then
      Exit(True);
    if (FCursor^ <> #32) and (FCursor^ <> #9) then
      Exit(True);
    Inc(FCursor);
  end;
  Exit(True);
end;

function TLineReader.ReadNextWord(out W: TAnsiView): Boolean;
begin
  W.Data := FCursor;
  while True do begin
    if FCursor >= FSourceEnd then
      Break;
    if Ord(FCursor^) <= 32 then
      Break;
    Inc(FCursor);
  end;
  W.Length := FCursor - W.Data;
  Result := W.Length > 0;
end;

function TLineReader.ReadString(out W: TAnsiView): Boolean;
begin
  if not SkipSpaces then
    Exit(False);
  if Cursor^ = '"' then begin
    // TODO special case
    Exit(ReadNextWord(W));
    if Result then begin
      W.Data := W.Data + 1;
      W.Length := W.Length - 1;
    end;
  end else if Cursor = '''' then begin
    // TODO special case
    Result := ReadNextWord(W);
    if Result then begin
      W.Data := W.Data + 1;
      W.Length := W.Length - 1;
    end;
  end else begin
    Exit(ReadNextWord(W));
  end;
  Exit(True);
end;

function TLineReader.ReadInt(out I: Int64): Boolean;
var
  Invert: Boolean;
begin
  I := 0;
  Invert := FCursor^ = '-';
  if Invert then begin
    Inc(FCursor);
    if FCursor >= FSourceEnd then
      Exit(False);
  end;
  while FCursor^ in ['0' .. '9'] do begin
    I := (I * 10) + Ord(FCursor^) - Ord('0');
    Inc(FCursor);
    if FCursor >= FSourceEnd then
      Break;
  end;
  if Invert then
    I := -I;
  Exit(True);
end;

function TLineReader.ReadIntOrDouble(out I: Int64; out F: Double): LongInt;
var
  Fraction: Int64;
begin
  if not ReadInt(I) then
    Exit(0);
  if FCursor^ = '.' then begin
    Inc(FCursor);
    if not ReadInt(Fraction) then
      Exit(0);
    Writeln('ReadIntOrDouble ', I, ' ', Fraction);
    F := Fraction;
    while F > 1 do
      F := F / 10;
    if I < 0 then
      F := - F;
    F := I + F;
    Exit(2);
  end;
  Exit(1);
end;

procedure TLineReader.Advance(Delta: LongInt);
begin
  // TODO calc line,pos
  Inc(FCursor, Delta);
end;

end.
