Initial check in rtl

src.rtl/dpgrtl.parser.pas

@@ -0,0 +1,231 @@
+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.