bds.mr.dpg/src.rtl/dpgrtl.parser.pas

unit dpgrtl.parser;

interface
uses
   System.SysUtils,
   dpgrtl.types;

type
   TParser = class
      protected
         fParserState   : IParserState;

      // ----------------------------------------------------------------------
      // Interface
      // ----------------------------------------------------------------------
      public
         procedure   ConsumeUntil(  ATokenType  : byte);             overload;
         procedure   ConsumeUntil(  ATokenSet   : TByteSet);         overload;

         procedure   Match(         ATokenSet   : TByteSet);         overload;
         procedure   Match(         ATokenType  : byte);             overload;
         procedure   MatchNot(      ATokenType  : byte);

         function    Mark: integer;             virtual;
         procedure   Rewind( Pos: integer);     virtual;

         procedure   ReportError(   e: Exception); overload; virtual;
         procedure   ReportError(   s: string);    overload; virtual;

         procedure   Consume;                   virtual; abstract;
         function    LA(i:integer): byte;       virtual; abstract;
         function    LT(i:integer): IToken;     virtual; abstract;

      // ----------------------------------------------------------------------
      // Construction/destruction
      // ----------------------------------------------------------------------
      public
         constructor Create( AState : IParserState);  overload;
         constructor Create( ABuffer: ITokenBuffer);  overload;
         constructor Create( AStream: ITokenStream);  overload;

      // ----------------------------------------------------------------------
      public
         property    InputState  : IParserState read  fParserState
                                                write fParserState;
   end;

   TParserClass = class of TParser;

implementation
uses
   dpgrtl.exception,
   dpgrtl.parserstate,
   dpgrtl.tokenbuffer;

{ TParser }

// @@@: Construction/destruction ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
//
//                                   Construction/destruction
//
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ================================================================================================
// Constructor(ParserState)
// ================================================================================================
constructor TParser.Create(AState: IParserState);
begin
   inherited Create;
   fParserState := AState
end;

// ================================================================================================
// Constructor(TokenBuffer)
// ================================================================================================
constructor TParser.Create(ABuffer: ITokenBuffer);
begin
   inherited Create;
   fParserState := TParserState.Create( ABuffer)
end;

// ================================================================================================
// Constructor(TokenStream)
// ================================================================================================
constructor TParser.Create(AStream: ITokenStream);
var
   tb: TTokenBuffer;

begin
   inherited Create;

   tb           := TTokenBuffer.Create(AStream);
   fParserState := TParserState.Create(tb);
end;

// @@@: Interface +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
//
//                                           Interface
//
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ================================================================================================
// ConsumeUntil(TokenType)
// ================================================================================================
procedure TParser.ConsumeUntil(ATokenType: byte);
var
   la1: byte;

begin
   la1 := LA(1);

   while (la1 <> TT_EOF) and (la1 <> ATokenType) do
   begin
      Consume;
      la1 := LA(1)
   end
end;

// ================================================================================================
// ConsumeUntil(TokenSet)
// ================================================================================================
procedure TParser.ConsumeUntil(ATokenSet: TByteSet);
var
   la1: byte;

begin
   la1 := LA(1);

   while (la1 <> TT_EOF) and not(la1 in ATokenSet) do
   begin
      Consume;
      la1 := LA(1)
   end
end;

// ================================================================================================
// Match Not
//
//    Make sure current lookahead symbol NOT matches token type 'pTokenType'. Throw an exception
//    upon mismatch, which is catched by either the error handler or by the syntactic predicate.
// ================================================================================================
procedure TParser.MatchNot(ATokenType: byte);
var
   la1: byte;

begin
   la1 := LA(1);

   if la1 = ATokenType
      then Raise EMismatchedToken.Create( LT(1), ATokenType, fParserState.FileName, true)
      else Consume
end;

// ================================================================================================
// Match
//
//    Make sure current lookahead symbol matches token type 'pTokenType'. Throw an exception upon
//    mismatch, which is catched by either the error handler or by the syntactic predicate.
// ================================================================================================
procedure TParser.Match(ATokenType: byte);
var
   la1: byte;
   lt1: IToken;

begin
   la1 := LA(1);

   if la1 <> ATokenType then
   begin
      lt1 := LT(1);
      Raise EMismatchedToken.Create( lt1, ATokenType, fParserState.FileName, false)
   end;

   Consume
end;

// ================================================================================================
// Match
//
//    Make sure current lookahead symbol matches the given set. Throw an exception upon mismatch,
//    which is catched by either the error handler or by the syntactic predicate.
// ================================================================================================
procedure TParser.Match(ATokenSet: TByteSet);
var
   la1: byte;

begin
   la1 := LA(1);

   if not (la1 in ATokenSet)
      then Raise EMismatchedToken.Create( LT(1), ATokenSet, fParserState.FileName, false)
      else Consume
end;

// ================================================================================================
// Mark
// ================================================================================================
function TParser.Mark: integer;
begin
   result := fParserState.InputBuffer.Mark
end;

// ================================================================================================
// Rewind
// ================================================================================================
procedure TParser.Rewind(Pos: integer);
begin
   fParserState.InputBuffer.Rewind(Pos)
end;

// ================================================================================================
// Report Error
// ================================================================================================
procedure TParser.ReportError(e: Exception);
begin
end;

// ================================================================================================
// Report Error
// ================================================================================================
procedure TParser.ReportError(s: string);
begin
end;

end.