{
  Copyright 1998-2026 PasDoc developers.

  This file is part of "PasDoc".

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

  "PasDoc" 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 General Public License for more details.

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

  ----------------------------------------------------------------------------
}

{
  @author(Johannes Berg <johannes@sipsolutions.de>)
  @author(Ralf Junker (delphi@zeitungsjunge.de))
  @author(Marco Schmidt (marcoschmidt@geocities.com))
  @author(Michalis Kamburelis)
  @author(Arno Garrels <first name.name@nospamgmx.de>)
  @abstract(Simple Pascal tokenizer.)

The @link(TTokenizer) object creates @link(TToken) objects (tokens) for the
Pascal programming language from a character input stream.

The @link(PasDoc_Scanner) unit does the same (it actually uses this unit's
tokenizer), with the exception that it evaluates compiler directives,
which are comments that start with a dollar sign. }

unit PasDoc_Tokenizer;

{$I pasdoc_defines.inc}

interface

uses
  Classes, Generics.Collections,
  PasDoc_Utils,
  PasDoc_Types,
  PasDoc_StreamUtils;

type
  { All types of tokens.

    Note that tokenizer is not able to tell whether you used
    standard directive (e.g. 'Register') as an identifier
    (e.g. you're declaring procedure named 'Register')
    or as a real standard directive (e.g. a calling specifier 'register').
    So there is @italic(no) token like TOK_STANDARD_DIRECTIVE here,
    standard directives are always reported as TOK_IDENTIFIER.
    You can check TToken.Info.StandardDirective to know whether
    this identifier is @italic(maybe) used as real standard directive. }
  TTokenType = (
    TOK_WHITESPACE,
    TOK_COMMENT_PAS,
    TOK_COMMENT_EXT,
    TOK_COMMENT_HELPINSIGHT,
    TOK_COMMENT_CSTYLE,
    TOK_IDENTIFIER,
    TOK_NUMBER,
    TOK_STRING,
    TOK_SYMBOL,
    // Compiler directive, like $ifdef
    TOK_DIRECTIVE,
    TOK_KEYWORD,
    TOK_ATT_ASSEMBLER_REGISTER,
    // Possible in assembler blocks, see ../../tests/ok_asm.pas
    TOK_DOUBLE_QUOTED_STRING
  );

type
  TKeyword = (
    KEY_INVALIDKEYWORD,
    KEY_AND,
    KEY_ARRAY,
    KEY_AS,
    KEY_ASM,
    KEY_BEGIN,
    KEY_CASE,
    KEY_CLASS,
    KEY_OBJCCLASS,
    KEY_CONST,
    KEY_CONSTRUCTOR,
    KEY_DESTRUCTOR,
    KEY_DISPINTERFACE,
    KEY_DIV,
    KEY_DO,
    KEY_DOWNTO,
    KEY_ELSE,
    KEY_END,
    KEY_EXCEPT,
    KEY_EXPORTS,
    KEY_FILE,
    KEY_FINALIZATION,
    KEY_FINALLY,
    KEY_FOR,
    KEY_FUNCTION,
    KEY_GOTO,
    KEY_IF,
    KEY_IMPLEMENTATION,
    KEY_IN,
    KEY_INHERITED,
    KEY_INITIALIZATION,
    KEY_INLINE,
    KEY_INTERFACE,
    KEY_IS,
    KEY_LABEL,
    KEY_LIBRARY,
    KEY_MOD,
    KEY_NIL,
    KEY_NOT,
    KEY_OBJECT,
    KEY_OF,
    KEY_OR,
    KEY_PACKED,
    KEY_PROCEDURE,
    KEY_PROGRAM,
    KEY_PROPERTY,
    KEY_RAISE,
    KEY_RECORD,
    KEY_REPEAT,
    KEY_RESOURCESTRING,
    KEY_SET,
    KEY_SHL,
    KEY_SHR,
    KEY_STRING,
    KEY_THEN,
    KEY_THREADVAR,
    KEY_TO,
    KEY_TRY,
    KEY_TYPE,
    KEY_UNIT,
    KEY_UNTIL,
    KEY_USES,
    KEY_VAR,
    KEY_WHILE,
    KEY_WITH,
    KEY_XOR
  );

  TStandardDirective = (
    SD_INVALIDSTANDARDDIRECTIVE,
    SD_ABSOLUTE,
    SD_ABSTRACT,
    SD_APIENTRY,
    SD_ASSEMBLER,
    SD_AUTOMATED,
    SD_CDECL,
    SD_CVAR,
    SD_DEFAULT,
    SD_DISPID,
    SD_DYNAMIC,
    SD_EXPERIMENTAL,
    SD_EXPORT,
    SD_EXTERNAL,
    SD_FAR,
    SD_FORWARD,
    SD_GENERIC,
    SD_HELPER,
    SD_INDEX,
    SD_INLINE,
    SD_MESSAGE,
    SD_NAME,
    SD_NEAR,
    SD_NODEFAULT,
    SD_NORETURN,
    SD_ON,
    SD_OPERATOR,
    SD_OUT,
    SD_OVERLOAD,
    SD_OVERRIDE,
    SD_PASCAL,
    SD_PRIVATE,
    SD_PROTECTED,
    SD_PUBLIC,
    SD_PUBLISHED,
    SD_READ,
    SD_REFERENCE,
    SD_REGISTER,
    SD_REINTRODUCE,
    SD_RESIDENT,
    SD_SEALED,
    SD_SPECIALIZE,
    SD_STATIC,
    SD_STDCALL,
    SD_STORED,
    SD_STRICT,
    SD_VIRTUAL,
    SD_WRITE,
    SD_DEPRECATED,
    SD_SAFECALL,
    SD_PLATFORM,
    SD_VARARGS,
    SD_FINAL,
    SD_UNIMPLEMENTED
  );

  TStandardDirectives = set of TStandardDirective;

const
  { Names of the token types. All start with lower letter.
    They should somehow describe (in a few short words) given
    TTokenType. }
  TOKEN_TYPE_NAMES: array[TTokenType] of string =
  ( 'whitespace', 'comment ((**)-style)', 'comment ({}-style)',
    'comment (///-style)',
    'comment (//-style)', 'identifier', 'number', 'string', 'symbol',
    'directive', 'reserved word', 'AT&T assembler register name', 'double-quoted string');

  TokenCommentTypes: set of TTokenType =
  [ TOK_COMMENT_PAS, TOK_COMMENT_EXT,
  TOK_COMMENT_HELPINSIGHT,
  TOK_COMMENT_CSTYLE ];

type
  { enumeration type that provides all types of symbols; each
    symbol's name starts with SYM_ }
  TSymbolType = (SYM_PLUS, SYM_MINUS, SYM_ASTERISK, SYM_SLASH, SYM_EQUAL,
    SYM_LESS_THAN, SYM_LESS_THAN_EQUAL, SYM_GREATER_THAN,
    SYM_GREATER_THAN_EQUAL, SYM_LEFT_BRACKET, SYM_RIGHT_BRACKET,
    SYM_COMMA, SYM_LEFT_PARENTHESIS, SYM_RIGHT_PARENTHESIS, SYM_COLON,
    SYM_SEMICOLON, SYM_DEREFERENCE, SYM_PERIOD, SYM_AT,
    SYM_DOLLAR, SYM_ASSIGN, SYM_RANGE, SYM_POWER,
    { SYM_BACKSLASH may occur when writing char constant "^\",
      see ../../tests/ok_caret_character.pas }
    SYM_BACKSLASH,
    // May occur in assembler blocks, see ../../tests/ok_asm.pas
    SYM_DOUBLE_QUOTE);

const
  { Symbols as strings. They can be useful to have some mapping
    TSymbolType -> string, but remember that actually some symbols
    in tokenizer have multiple possible representations,
    e.g. "right bracket" is usually given as "]" but can also
    be written as ".)". }
  SymbolNames: array[TSymbolType] of string =
  ( '+', '-', '*', '/', '=', '<', '<=', '>', '>=', '[', ']', ',',
    '(', ')', ':', ';', '^', '.', '@', '$', ':=', '..', '**', '\', '"' );

type
  { Stores the exact type and additional information on one token. }
  TToken = class(TObject)
  private
    FEndPosition: Int64;
    FBeginPosition: Int64;
    FStreamName: string;
    FStreamAbsoluteFileName: string;
    FLine: Integer;
  public
    { the exact character representation of this token as it was found in the
      input file }
    Data: string;

    { the type of this token as @link(TTokenType) }
    MyType: TTokenType;

    { additional information on this token as a variant record depending
      on the token's MyType }
    Info: record
      case TTokenType of
        TOK_SYMBOL:
          (SymbolType: TSymbolType);
        TOK_KEYWORD:
          (KeyWord: TKeyWord);
        TOK_IDENTIFIER:
          (StandardDirective: TStandardDirective);
    end;

    { Contents of a comment token.
      This is defined only when MyType is in TokenCommentTypes
      or is TOK_DIRECTIVE.
      This is the text within the comment @italic(without) comment delimiters.
      For TOK_DIRECTIVE you can safely assume that CommentContent[1] = '$'. }
    CommentContent: string;

    { Contents of the string token, that is: the value of the string literal.
      D only when MyType is TOK_STRING. }
    StringContent: string;

    { Create a token of and assign the argument token type to @link(MyType) }
    constructor Create(const TT: TTokenType);
    function GetTypeName: string;

    { Does @link(MyType) is TOK_SYMBOL and Info.SymbolType is ASymbolType ? }
    function IsSymbol(const ASymbolType: TSymbolType): Boolean;

    { Does @link(MyType) is TOK_KEYWORD and Info.KeyWord is AKeyWord ? }
    function IsKeyWord(const AKeyWord: TKeyWord): Boolean;

    { Does @link(MyType) is TOK_IDENTIFIER and Info.StandardDirective is
      AStandardDirective ? }
    function IsStandardDirective(
      const AStandardDirective: TStandardDirective): Boolean;

    { Few words long description of this token.
      Describes MyType and Data (for those tokens that tend to have short Data).
      Starts with lower letter. }
    function Description: string;

    { Informative to user name of the stream from which this token was read.
      This can be a filename (relative or absolute, however user specified
      it), but it also can be something arbitrary like "$if / $elseif condition".
      So don't treat it like a reliable filename.

      It is currently used to set @link(TRawDescriptionInfo.StreamName). }
    property StreamName: string read FStreamName;

    { Filename, always absolute, of the underlying file of this stream.
      Empty ('') if this is not a file stream. }
    property StreamAbsoluteFileName: string read FStreamAbsoluteFileName;

    // @name is the position in the stream of the start of the token.
    // It is currently used to set @link(TRawDescriptionInfo.BeginPosition).
    property BeginPosition: Int64 read FBeginPosition;

    // @name is the position in the stream of the character immediately
    // after the end of the token.
    // It is currently used to set @link(TRawDescriptionInfo.EndPosition).
    property EndPosition: Int64 read FEndPosition;

    // Line number (1-based) in the stream where this token starts.
    property Line: Integer read FLine;
  end;

  TTokenList = {$ifdef FPC}specialize{$endif} TObjectList<TToken>;

  { @abstract(Converts an input TStream to a sequence of @link(TToken) objects.) }
  TTokenizer = class(TObject)
  private
    FBufferedCharSize : Integer;
    FBufferedToken: TToken;
    function StreamPosition: Int64;
  protected
    FOnMessage: TPasDocMessageEvent;
    FVerbosity: Cardinal;
    { if @link(IsCharBuffered) is true, this field contains the buffered
      character }
    BufferedChar: Char;
    { true if end of stream @link(Stream) has been reached, false otherwise }
    EOS: Boolean;
    { if this is true, @link(BufferedChar) contains a buffered character;
      the next call to @link(GetChar) or @link(PeekChar) will return this
      character, not the next in the associated stream @link(Stream) }
    IsCharBuffered: Boolean;
    { current line number in stream @link(Stream); useful when giving error messages }
    Line: Integer;
    { Input stream this tokenizer is working on.
      In case of STRING_UNICODE, all reads should go through the TStreamReader API,
      so underlying TStream is not exposed as a field even. }
    {$ifdef STRING_UNICODE}
    StreamReader: TStreamReader;
    {$else}
    Stream: TStream;
    {$endif}
    FStreamName: string;
    FStreamAbsoluteFileName: string;

    procedure DoError(const AMessage: string; const AArguments: array of const);
    procedure DoMessage(const AVerbosity: Cardinal; const MessageType:
      TPasDocMessageType; const AMessage: string; const AArguments: array of const);

    procedure CheckForDirective(const t: TToken);
    procedure ConsumeChar;

    function CreateSymbolToken(const st: TSymbolType; const s: string):
      TToken; overload;

    { Uses default symbol representation, from SymbolNames[st] }
    function CreateSymbolToken(const st: TSymbolType): TToken; overload;

    { Read next character (WideChar in case of STRING_UNICODE).
      Returns how many bytes this character takes, or 0 if cannot read. }
    function GetChar(out c: {$ifdef STRING_UNICODE} WideChar {$else} AnsiChar {$endif}): Integer;
    function PeekChar(out c: Char): Boolean;
    function ReadCommentType1: TToken;
    function ReadCommentType2: TToken;
    function ReadCommentType3: TToken;
    function ReadAttAssemblerRegister: TToken;
    function ReadLiteralString: TToken;
    function ReadDoubleQuotedString: TToken;

    { Read the rest of token of type TokenType,
      knowing the 1st character of this token is StartChar,
      and subsequent characters of this token are in set AllowedChars.

      Returns @true and sets T if we successfully read such token,
      returns @false (and sets T to @nil) otherwise.
      The @false result means we encountered an error reading the next character
      from stream (we are not at end of stream, but TTokenizer.GetChar returned 0). }
    function ReadToken(const StartChar: Char; const AllowedChars: TCharSet;
      const TokenType: TTokenType; out T: TToken): Boolean;

    { Like ReadToken, but for identifiers. The set of valid subsequent characters
      is defined by IsIdentifierOtherChar function, and the token type is
      always TOK_IDENTIFIER. }
    function ReadIdentifierToken(const StartChar: Char; out T: TToken): Boolean;
  public
    { Creates a TTokenizer and associates it with given input TStream.
      Note that AStream will be freed when this object will be freed. }
    constructor Create(
      const AStream: TStream;
      const OnMessageEvent: TPasDocMessageEvent;
      const VerbosityLevel: Cardinal;
      const AStreamName, AStreamAbsoluteFileName: string);
    { Releases all dynamically allocated memory. }
    destructor Destroy; override;
    function HasData: Boolean;
    function GetStreamInfo: string;
    { Get next token from stream.

      @param(NilOnEnd If @true, return @nil once stream ends.
        Otherwise we make exception about it.)

      @param(NilOnInvalidContent If @true, return @nil on some invalid content,
        like "!" which is not Pascal token at all.
        This parameter is independent from NilOnEnd.
        The "invalid content" affected by this parameter is still something
        that "we can read to advance our position within the stream".)
    }
    function GetToken(const NilOnEnd: Boolean = false;
      const NilOnInvalidContent: Boolean = false): TToken;

    { Makes the token T next to be returned by GetToken.
      Also sets T to @nil, to prevent you from freeing it accidentally.

      You cannot have more than one "unget" token.
      If you only call UnGetToken after some GetToken, you are safe. }
    procedure UnGetToken(var T: TToken);

    { Skip all chars until it encounters some compiler directive,
      like $ELSE or $ENDIF.
      Returns either @nil or a token with MyType = TOK_DIRECTIVE. }
    function SkipUntilCompilerDirective: TToken;

    property OnMessage: TPasDocMessageEvent read FOnMessage write FOnMessage;
    property Verbosity: Cardinal read FVerbosity write FVerbosity;

    { Informative to user name of the stream from which this token was read.
      This can be a filename (relative or absolute, however user specified
      it), but it also can be something arbitrary like "$if / $elseif condition".

      So don't treat it like a reliable filename, for this use
      StreamAbsoluteFileName. }
    property StreamName: string read FStreamName;

    { Filename, always absolute, of the underlying file of this stream.
      Empty ('') if this is not a file stream. }
    property StreamAbsoluteFileName: string read FStreamAbsoluteFileName;
  end;

const
  { all Object Pascal keywords }
  KeyWordArray: array[Low(TKeyword)..High(TKeyword)] of string =
  ('x', // lowercase never matches
    'AND', 'ARRAY', 'AS', 'ASM', 'BEGIN', 'CASE', 'CLASS', 'OBJCCLASS', 'CONST',
    'CONSTRUCTOR', 'DESTRUCTOR', 'DISPINTERFACE', 'DIV',  'DO', 'DOWNTO',
    'ELSE', 'END', 'EXCEPT', 'EXPORTS', 'FILE', 'FINALIZATION',
    'FINALLY', 'FOR', 'FUNCTION', 'GOTO', 'IF', 'IMPLEMENTATION',
    'IN', 'INHERITED', 'INITIALIZATION', 'INLINE', 'INTERFACE',
    'IS', 'LABEL', 'LIBRARY', 'MOD', 'NIL', 'NOT', 'OBJECT', 'OF',
    'OR', 'PACKED', 'PROCEDURE', 'PROGRAM', 'PROPERTY',
    'RAISE', 'RECORD', 'REPEAT', 'RESOURCESTRING', 'SET', 'SHL',
    'SHR', 'STRING', 'THEN', 'THREADVAR', 'TO', 'TRY', 'TYPE',
    'UNIT', 'UNTIL', 'USES', 'VAR', 'WHILE', 'WITH', 'XOR');

  { Object Pascal directives }
  StandardDirectiveArray:
    array[Low(TStandardDirective)..High(TStandardDirective)] of PChar =
  ('x', // lowercase letters never match
    'ABSOLUTE', 'ABSTRACT', 'APIENTRY', 'ASSEMBLER', 'AUTOMATED',
    'CDECL', 'CVAR', 'DEFAULT', 'DISPID', 'DYNAMIC', 'EXPERIMENTAL', 'EXPORT', 'EXTERNAL',
    'FAR', 'FORWARD', 'GENERIC', 'HELPER', 'INDEX', 'INLINE', 'MESSAGE', 'NAME', 'NEAR',
    'NODEFAULT', 'NORETURN', 'ON', 'OPERATOR', 'OUT', 'OVERLOAD', 'OVERRIDE', 'PASCAL', 'PRIVATE',
    'PROTECTED', 'PUBLIC', 'PUBLISHED', 'READ', 'REFERENCE', 'REGISTER',
    'REINTRODUCE', 'RESIDENT', 'SEALED', 'SPECIALIZE', 'STATIC',
    'STDCALL', 'STORED', 'STRICT', 'VIRTUAL',
    'WRITE', 'DEPRECATED', 'SAFECALL', 'PLATFORM', 'VARARGS', 'FINAL',
    'UNIMPLEMENTED');

{ Checks is Name (case ignored) some Pascal keyword.
  Returns SD_INVALIDSTANDARDDIRECTIVE if not. }
function StandardDirectiveByName(const Name: string): TStandardDirective;

{ Checks is Name (case ignored) some Pascal standard directive.
  Returns KEY_INVALIDKEYWORD if not. }
function KeyWordByName(const Name: string): TKeyword;

{ Returns true if c is a valid first character of a Pascal identifier:
  underscore, ASCII letter, or non-ASCII character (Unicode letter).
  Following https://docwiki.embarcadero.com/RADStudio/Athens/en/Identifiers ,
  Delphi allows Unicode letters as identifier start characters. }
function IsIdentifierStartChar(const C: Char): Boolean;

{ Returns true if c is a valid continuation character of a Pascal identifier:
  underscore, ASCII letter, ASCII digit, or non-ASCII character (Unicode letter/digit). }
function IsIdentifierOtherChar(const C: Char): Boolean;

implementation

uses SysUtils, Math;

function KeyWordByName(const Name: string): TKeyword;
var
  LName: string;
  i: TKeyword;
begin
  LName := UpperCase(Name);
  Result := KEY_INVALIDKEYWORD;
  for i := Low(TKeyword) to High(TKeyword) do begin
    if LName = KeyWordArray[i] then begin
      Result := i;
      break;
    end;
  end;
end;

function StandardDirectiveByName(const Name: string): TStandardDirective;
var
  LName: string;
  i: TStandardDirective;
begin
  LName := UpperCase(Name);
  Result := SD_INVALIDSTANDARDDIRECTIVE;
  for i := Low(TStandardDirective) to High(TStandardDirective) do begin
    if LName = StandardDirectiveArray[i] then begin
      Result := i;
      break;
    end;
  end;
end;

type
  TSingleCharSymbol = record
    c: Char;
    s: TSymbolType;
  end;

const
  Whitespace = [#9, #10, #13, ' '];
  Letters = ['A'..'Z', 'a'..'z'];
  DecimalDigits = ['0'..'9'];
  HexadecimalDigits = DecimalDigits + ['A'..'F', 'a'..'f'];
  IdentifierStart = ['_'] + Letters;
  IdentifierOther = IdentifierStart + DecimalDigits;
  CharOther = HexadecimalDigits + ['$'];
  NumberStart = DecimalDigits + ['$'];
  NumberOther = HexadecimalDigits + ['.', '+', '-'];
  QuoteChar = '''';
  NUM_SINGLE_CHAR_SYMBOLS = 10;
  SingleCharSymbols: array[0..NUM_SINGLE_CHAR_SYMBOLS - 1] of TSingleCharSymbol =
  ((c: ';'; s: SYM_SEMICOLON),
    (c: ','; s: SYM_COMMA),
    (c: '['; s: SYM_LEFT_BRACKET),
    (c: ']'; s: SYM_RIGHT_BRACKET),
    (c: '+'; s: SYM_PLUS),
    (c: '-'; s: SYM_MINUS),
    (c: '*'; s: SYM_ASTERISK),
    (c: '='; s: SYM_EQUAL),
    (c: '^'; s: SYM_DEREFERENCE),
    (c: '@'; s: SYM_AT));

function IsIdentifierStartChar(const C: Char): Boolean;
begin
  Result := CharInSet(C, IdentifierStart) or (Ord(C) > 127);
end;

function IsIdentifierOtherChar(const C: Char): Boolean;
begin
  Result := CharInSet(C, IdentifierOther) or (Ord(C) > 127);
end;

{ ---------------------------------------------------------------------------- }
{ TToken }
{ ---------------------------------------------------------------------------- }

constructor TToken.Create(const TT: TTokenType);
begin
  inherited Create;
  MyType := TT;
end;

{ ---------------------------------------------------------------------------- }

function TToken.GetTypeName: string;
begin
  GetTypeName := TOKEN_TYPE_NAMES[MyType];
end;

{ ---------------------------------------------------------------------------- }

function TToken.IsSymbol(const ASymbolType: TSymbolType): Boolean;
begin
  Result := (MyType = TOK_SYMBOL) and (Info.SymbolType = ASymbolType);
end;

function TToken.IsKeyWord(const AKeyWord: TKeyWord): Boolean;
begin
  Result := (MyType = TOK_KEYWORD) and (Info.KeyWord = AKeyWord);
end;

function TToken.IsStandardDirective(
  const AStandardDirective: TStandardDirective): Boolean;
begin
  Result := (MyType = TOK_IDENTIFIER) and
    (Info.StandardDirective = AStandardDirective);
end;

function TToken.Description: string;
begin
  Result := TOKEN_TYPE_NAMES[MyType];
  if MyType in [TOK_SYMBOL, TOK_KEYWORD, TOK_IDENTIFIER] then
    Result := Result + ' "' + Data + '"';
end;

{ ---------------------------------------------------------------------------- }
{ TTokenizer }
{ ---------------------------------------------------------------------------- }

constructor TTokenizer.Create(
  const AStream: TStream;
  const OnMessageEvent: TPasDocMessageEvent;
  const VerbosityLevel: Cardinal;
  const AStreamName, AStreamAbsoluteFileName: string);
begin
  inherited Create;
  FOnMessage := OnMessageEvent;
  FVerbosity := VerbosityLevel;
  Line := 1;
  {$ifdef STRING_UNICODE}
  StreamReader := TStreamReader.Create(AStream);
  StreamReader.OwnStream;
  {$else}
  Stream := AStream;
  {$endif}
  FStreamName := AStreamName;
  FStreamAbsoluteFileName := AStreamAbsoluteFileName;
end;

{ ---------------------------------------------------------------------------- }

destructor TTokenizer.Destroy;
begin
  {$ifdef STRING_UNICODE}
  FreeAndNil(StreamReader);
  {$else}
  FreeAndNil(Stream);
  {$endif}
  FBufferedToken.Free;
  inherited;
end;

{ ---------------------------------------------------------------------------- }
procedure TTokenizer.CheckForDirective(const t: TToken);
begin
  if SCharIs(T.CommentContent, 1, '$') then
    t.MyType := TOK_DIRECTIVE;
end;

{ ---------------------------------------------------------------------------- }

procedure TTokenizer.ConsumeChar;
begin
  IsCharBuffered := False;
end;

{ ---------------------------------------------------------------------------- }

function TTokenizer.CreateSymbolToken(const st: TSymbolType;
  const s: string): TToken;
begin
  Result := TToken.Create(TOK_SYMBOL);
  with Result do begin
    Info.SymbolType := st;
    Data := s;
  end;
end;

function TTokenizer.CreateSymbolToken(const st: TSymbolType): TToken;
begin
  Result := CreateSymbolToken(st, SymbolNames[st]);
end;

{ ---------------------------------------------------------------------------- }

procedure TTokenizer.DoError(const AMessage: string;
  const AArguments: array of const);
begin
  raise EPasDoc.Create(AMessage + Format(' (at %s)', [GetStreamInfo]),
    AArguments, 2);
end;

{ ---------------------------------------------------------------------------- }

procedure TTokenizer.DoMessage(const AVerbosity: Cardinal; const MessageType:
  TPasDocMessageType; const AMessage: string; const AArguments: array of const);
begin
  if (AVerbosity < FVerbosity) and Assigned(FOnMessage) then
    FOnMessage(MessageType, Format(AMessage, AArguments), AVerbosity);
end;

{ ---------------------------------------------------------------------------- }

function TTokenizer.GetChar(out c: {$ifdef STRING_UNICODE} WideChar {$else} AnsiChar {$endif}): Integer;
{$ifdef STRING_UNICODE}
var
  CharArray: TCharArray;
{$endif}
begin
  if IsCharBuffered then
  begin
    c := BufferedChar;
    IsCharBuffered := False;
    Result := FBufferedCharSize;
  end else
  begin
    {$ifdef STRING_UNICODE}
    { Do not call StreamReader.Read when EndOfStream,
      otherwise (for TStringStream) the StreamReader.Read at the end of string
      would return 1 character with code 0.
      This would trip our tokenizer, 0 is invalid character in input. }
    if StreamReader.EndOfStream then
      Exit(0);

    SetLength(CharArray, 1);
    Result := StreamReader.Read(CharArray, 0, 1) * SizeOf(WideChar);
    if Result <> 0 then
      C := CharArray[0];
    {$else}
    Result := Stream.Read(c, 1);
    {$endif}
  end;
end;

{ ---------------------------------------------------------------------------- }

function TTokenizer.GetStreamInfo: string;
begin
  GetStreamInfo := FStreamName + '(' + IntToStr(Line) + ')';
end;

{ ---------------------------------------------------------------------------- }

function TTokenizer.HasData: Boolean;
begin
  HasData := IsCharBuffered or
    {$ifdef STRING_UNICODE}
    (not StreamReader.EndOfStream)
    {$else}
    (Stream.Position < Stream.Size)
    {$endif};
end;

{ ---------------------------------------------------------------------------- }

function TTokenizer.StreamPosition: Int64;
{$ifdef STRING_UNICODE}
var
  Stream: TStream;
{$endif}
begin
  {$ifdef STRING_UNICODE}
  Stream := StreamReader.BaseStream;
  {$endif}

  if IsCharBuffered then
    Result := Stream.Position - FBufferedCharSize
  else
    Result := Stream.Position;
end;

{ ---------------------------------------------------------------------------- }

function TTokenizer.GetToken(const NilOnEnd, NilOnInvalidContent: Boolean): TToken;
var
  c: Char;
  MaybeKeyword: TKeyword;
  s: string;
  J: Integer;
  BeginPosition: integer;
begin
  if Assigned(FBufferedToken) then
  begin
    { we have a token buffered, we'll return this one }
    Result := FBufferedToken;
    FBufferedToken := nil;
    Exit;
  end;

  Result := nil;
  BeginPosition := StreamPosition; //used in finally
  try
    if GetChar(c) = 0 then
      if NilOnEnd then
        Exit(nil)
      else
        DoError('Tokenizer: could not read character, unexpected end of stream', []);

    if CharInSet(c, Whitespace) then
    begin
      if ReadToken(c, Whitespace, TOK_WHITESPACE, Result) then
          { after successful reading all whitespace characters, update
            internal line counter to be able to state current line on errors.
            Count both types of possible EOLs and select the max one }
        Inc(Line, Max(StrCountCharA(Result.Data, #10), StrCountCharA(Result.Data, #13)))
      else
        DoError('Tokenizer: could not read character', []);
    end else
    if IsIdentifierStartChar(c) then
    begin
      if ReadIdentifierToken(c, Result) then
      begin
        s := Result.Data;
        { check if identifier is a keyword }
        MaybeKeyword := KeyWordByName(s);
        if (MaybeKeyword <> KEY_INVALIDKEYWORD) then
        begin
          Result.MyType := TOK_KEYWORD;
          Result.Info.KeyWord := MaybeKeyword;
        end else
        begin
          { calculate Result.Info.StandardDirective }
          Result.Info.StandardDirective := StandardDirectiveByName(s);
        end;
      end;
    end else
    if CharInSet(c, NumberStart) then
      ReadToken(c, NumberOther, TOK_NUMBER, Result)
    else
      case c of
        QuoteChar:Result := ReadLiteralString;
        '#':
          if ReadToken(c, CharOther, TOK_STRING, Result) then
          begin
            try
              { Note that StrToInt automatically handles hex characters when
                number starts from $. So below will automatically work for them.

                Using typecast AnsiString explicitly, to avoid warning with FPC.
                Yes, we deliberately convert WideChar to AnsiString,
                and let it fail if it cannot be handled in current encoding. }
              Result.StringContent := {$ifndef STRING_UNICODE} AnsiString {$endif}
                (WideChar(StrToInt(SEnding(Result.Data, 2))));
            except
              { In case of EConvertError, make a warning and continue.
                Result.StringContent will remain empty, which isn't a real problem. }
              on E: EConvertError do
                DoMessage(2, pmtWarning, 'Cannot convert string character code to int: %s', [Result.Data]);
            end;
          end;
        '{': begin
            Result := ReadCommentType1;
            CheckForDirective(Result);
          end;
        '(': begin
            c := ' ';
            if HasData and not PeekChar(c) then
              DoError('Tokenizer: could not read character', []);
            case c of
              '*': begin
                  ConsumeChar;
                  Result := ReadCommentType2;
                  CheckForDirective(Result);
                end;
              '.': begin
                  ConsumeChar;
                  Result := CreateSymbolToken(SYM_LEFT_BRACKET, '(.');
                end;
            else
              Result := CreateSymbolToken(SYM_LEFT_PARENTHESIS);
            end;
          end;
        ')': begin
            c := ' ';
            Result := CreateSymbolToken(SYM_RIGHT_PARENTHESIS);
          end;
        '.': begin
            c := ' ';
            if HasData and (not PeekChar(c)) then Exit;
            case c of
              '.': begin
                  ConsumeChar;
                  Result := CreateSymbolToken(SYM_RANGE);
                end;
              ')': begin
                  ConsumeChar;
                  Result := CreateSymbolToken(SYM_RIGHT_BRACKET, '.)');
                end;
            else
              Result := CreateSymbolToken(SYM_PERIOD);
            end;
          end;
        '/': begin
            c := ' ';
            if HasData and (not PeekChar(c)) then Exit;
            case c of
              '/': begin
                  ConsumeChar;
                  Result := ReadCommentType3;
                end;
            else
              Result := CreateSymbolToken(SYM_SLASH);
            end;
          end;
        ':': begin
            c := ' ';
            if HasData and (not PeekChar(c)) then Exit;
            case c of
              '=': begin
                  ConsumeChar;
                  Result := CreateSymbolToken(SYM_ASSIGN);
                end;
            else
              Result := CreateSymbolToken(SYM_COLON);
            end;
          end;
        '<': begin
            c := ' ';
            if HasData and (not PeekChar(c)) then Exit;
            case c of
              '=': begin
                  ConsumeChar;
                  Result := CreateSymbolToken(SYM_LESS_THAN_EQUAL);
                end;
            else
              Result := CreateSymbolToken(SYM_LESS_THAN);
            end;
          end;
        '>': begin
            c := ' ';
            if HasData and (not PeekChar(c)) then Exit;
            case c of
              '=': begin
                  ConsumeChar;
                  Result := CreateSymbolToken(SYM_GREATER_THAN_EQUAL);
                end;
            else
              Result := CreateSymbolToken(SYM_GREATER_THAN);
            end;
          end;
        '*': begin
            c := ' ';
            if HasData and (not PeekChar(c)) then Exit;
            case c of
              '*': begin
                  ConsumeChar;
                  Result := CreateSymbolToken(SYM_POWER);
                end;
            else
              Result := CreateSymbolToken(SYM_ASTERISK);
            end;
          end;
        '\': Result := CreateSymbolToken(SYM_BACKSLASH);
        '%': Result := ReadAttAssemblerRegister;
        '"': Result := ReadDoubleQuotedString;
        '&': begin
               if not (GetChar(C) > 0) then
               begin
                 if NilOnInvalidContent then
                   Exit(nil)
                 else
                   DoError('Cannot read valid identifier after "&" prefix', []);
               end else
               if CharInSet(C, DecimalDigits) then
               begin
                 { Octal number literal: &<octal-digits>, e.g. &4000 }
                 ReadToken(C, DecimalDigits, TOK_NUMBER, Result);
                 Result.Data := '&' + Result.Data;
               end else
               if not (IsIdentifierStartChar(C) and
                       ReadIdentifierToken(C, Result)) then
               begin
                 if NilOnInvalidContent then
                   Exit(nil)
                 else
                   DoError('Cannot read valid identifier after "&" prefix', []);
               end;
             end;
      else begin
          for J := 0 to NUM_SINGLE_CHAR_SYMBOLS - 1 do begin
            if (c = SingleCharSymbols[J].c) then begin
              Result := CreateSymbolToken(SingleCharSymbols[J].s, c);
              exit;
            end;
          end;
          if NilOnInvalidContent then
            Exit(nil)
          else
            DoError('Invalid character ("%s", code %d) in Pascal input stream', [C, Ord(C)]);
        end;
      end;
  finally
    if Result <> nil then
    begin
      Result.FStreamName := StreamName;
      Result.FStreamAbsoluteFileName := StreamAbsoluteFileName;
      Result.FBeginPosition := BeginPosition;
      Result.FEndPosition := StreamPosition;
      Result.FLine := Line;
    end;
  end;
end;

{ ---------------------------------------------------------------------------- }

function TTokenizer.PeekChar(out c: Char): Boolean;
begin
  if IsCharBuffered then begin
    c := BufferedChar;
    Result := True;
  end
  else begin
    FBufferedCharSize := GetChar(c);
    if FBufferedCharSize > 0 then
    begin
      BufferedChar := c;
      IsCharBuffered := True;
      Result := True;
    end
    else begin
      EOS := True;
      PeekChar := False;
    end;
  end;
end;

{ ---------------------------------------------------------------------------- }

{ Check if current char is EOL and increases Line counter.
  PrevCh is previously taken char (used here to not increase counter on
  the 2nd character in case of CR-LF line ending). }
procedure HandleEOL(PrevCh, CurrCh: Char; var Line: Integer);
begin
  case CurrCh of
    #10:
      // handle #13#10 case
      if PrevCh <> #13 then
        Inc(Line);
    #13:
      Inc(Line);
  end;
end;

function TTokenizer.ReadCommentType1: TToken;
var
  c, prevC: Char;
begin
  Result := TToken.Create(TOK_COMMENT_EXT);
  with Result do
  begin
    CommentContent := ''; prevC := #0;
    repeat
      if not HasData or (GetChar(c) = 0) then Exit;
      HandleEOL(prevC, c, Self.Line);
      prevC := c;
      CommentContent := CommentContent + c; // TODO: Speed up!
    until c = '}';

    Data := '{' + CommentContent;
    (* Remove last '}' from CommentContent *)
    SetLength(CommentContent, Length(CommentContent) - 1);
  end;
end;

{ ---------------------------------------------------------------------------- }

function TTokenizer.ReadCommentType2: TToken;
var
  c, prevC: Char;
begin
  Result := TToken.Create(TOK_COMMENT_PAS);
  Result.CommentContent := ''; prevC := #0;
  if not HasData or (GetChar(c) = 0) then Exit;
  repeat
    Result.CommentContent := Result.CommentContent + c;

    if c <> '*' then begin
      HandleEOL(prevC, c, Line);
      prevC := c;
      if not HasData or (GetChar(c) = 0) then Exit;
    end else begin
      if not HasData or (GetChar(c) = 0) then Exit;
      if c = ')' then
        begin
          ConsumeChar;
          Result.Data := '(*' + Result.CommentContent + ')';
          { Remove last '*' from Result.CommentContent }
          SetLength(Result.CommentContent, Length(Result.CommentContent) - 1);
          Break;
        end;
    end;
  until False;
end;

{ ---------------------------------------------------------------------------- }

function TTokenizer.ReadCommentType3: TToken;
var
  C: Char;
  pos: Integer;
  Prefix: string;
begin
  Result := TToken.Create(TOK_COMMENT_CSTYLE);
  with Result do
  begin
    CommentContent := '';
    pos := 0;

    Prefix := '//';
    while HasData and PeekChar(C) do
    begin
      case c of
        { break without consuming newline characters.
          This way line numbers about back comments will indicate the correct line. }
        #10, #13: Break;
        else
        begin
          if (c = '/') and (pos = 0) then
          begin
            MyType := TOK_COMMENT_HELPINSIGHT;
            Prefix := '///';
          end else
            CommentContent := CommentContent + c;
          ConsumeChar;
        end;
      end;
      Inc(pos);
    end;

    Data := Prefix + CommentContent;
  end;
end;

{ ---------------------------------------------------------------------------- }

function TTokenizer.ReadAttAssemblerRegister: TToken;
var
  C: char;
begin
  Result := TToken.Create(TOK_ATT_ASSEMBLER_REGISTER);

  Result.Data := '%';
  repeat
    if (not HasData) or (not PeekChar(C)) then Exit;
    if CharInSet(C, ['a'..'z', 'A'..'Z', '0'..'9']) then
    begin
      GetChar(C);
      Result.Data := Result.Data + C;
    end else
      Break;
  until false;
end;

{ ---------------------------------------------------------------------------- }

function TTokenizer.ReadDoubleQuotedString: TToken;
var
  C: char;
begin
  Result := TToken.Create(TOK_DOUBLE_QUOTED_STRING);
  Result.Data := '"';
  repeat
    if not HasData then
    begin
      FreeAndNil(Result);
      DoError('Tokenizer: unexpected end of stream inside double-quoted string', []);
    end;

    if GetChar(c) = 0 then
    begin
      FreeAndNil(Result);
      DoError('Tokenizer: could not read character inside double-quoted string', []);
    end;

    if CharInSet(C, [#10, #13]) then
    begin
      FreeAndNil(Result);
      DoError('Newline inside a double-quoted string is not allowed', []);
    end;

    Result.Data := Result.Data + C;
  until C = '"';
end;

{ ---------------------------------------------------------------------------- }

function TTokenizer.ReadLiteralString: TToken;
var
  c: Char;
  Finished: Boolean;
begin
  Finished := False;

  Result := TToken.Create(TOK_STRING);
  Result.Data := '''';

  repeat
    if not HasData then begin
      FreeAndNil(Result);
      DoError('Tokenizer: unexpected end of stream', []);
    end;
    if GetChar(c) = 0 then begin
      FreeAndNil(Result);
      DoError('Tokenizer: could not read character', []);
    end;
    if c = QuoteChar then begin
      if PeekChar(c) and (c = QuoteChar) then { escaped single quote within string } begin
        ConsumeChar;
        Result.Data := Result.Data + QuoteChar;
      end
      else { end of string } begin
        Finished := True;
      end;
      Result.Data := Result.Data + QuoteChar;
    end
    else
    if CharInSet(c, [#10, #13]) then
    begin
      FreeAndNil(Result);
      { Note: Do not show here exact code (#13 or #10) to make auto tests succeed,
        regardless of line endings in cloned repo (Windows or Linux). }
      DoError('Newline inside a literal string is not allowed', []);
    end
    else begin
      Result.Data := Result.Data + c;
    end;
    { Note that, because of logic above, this will append only ONE apostrophe
      when reading two apostrophes in source code.
      Checking Finished prevents adding the ending apostrophe. }
    if not Finished then
      Result.StringContent := Result.StringContent + c;
  until Finished;
end;

{ ---------------------------------------------------------------------------- }

function TTokenizer.ReadToken(const StartChar: Char; const AllowedChars: TCharSet;
  const TokenType: TTokenType; out T: TToken): Boolean;
var
  PeekedChar: Char;
begin
  Result := true;
  T := TToken.Create(TokenType);
  T.Data := StartChar;

  repeat
    if not PeekChar(PeekedChar) then
    begin
      if not EOS then
      begin
        FreeAndNil(T);
        Exit(false);
      end;
      break;
    end;

    if CharInSet(PeekedChar, AllowedChars) then
    begin
      T.Data := T.Data + PeekedChar;
      ConsumeChar;
    end else
      break;
  until false;

  Assert(Result);
  Assert(Assigned(T));
end;

function TTokenizer.ReadIdentifierToken(const StartChar: Char; out T: TToken): Boolean;
var
  PeekedChar: Char;
begin
  Result := true;
  T := TToken.Create(TOK_IDENTIFIER);
  T.Data := StartChar;

  repeat
    if not PeekChar(PeekedChar) then
    begin
      if not EOS then
      begin
        FreeAndNil(T);
        Exit(false);
      end;
      break;
    end;

    if IsIdentifierOtherChar(PeekedChar) then
    begin
      T.Data := T.Data + PeekedChar;
      ConsumeChar;
    end else
      break;
  until false;

  Assert(Result);
  Assert(Assigned(T));
end;

function TTokenizer.SkipUntilCompilerDirective: TToken;
begin
  Result := nil;
  repeat
    FreeAndNil(Result);
    Result := GetToken(false, true);
    if Result <> nil then // above GetToken will return nil on invalid content, like "!"
    begin
      CheckForDirective(Result);
      if Result.MyType = TOK_DIRECTIVE then break;
    end;
  until false;
end;

procedure TTokenizer.UnGetToken(var T: TToken);
begin
  if Assigned(FBufferedToken) then
    DoError('Cannot UnGet more than one token in TTokenizer', []);

  FBufferedToken := T;
  T := nil;
end;

end.
