Initial check in rtl

src.rtl/dpgrtl.treeparser.pas

@@ -0,0 +1,147 @@
+unit dpgrtl.treeparser;
+
+interface
+uses
+   dpgrtl.types,
+   dpgrtl.astBase,
+   dpgrtl.astFactory,
+   dpgrtl.treeparserstate;
+
+type
+   TTreeParser = class
+
+         // The AST Null object; the parsing cursor is set to this when
+         // it is found to be null.  This way, we can test the token type
+         // of a node without having to have tests for null everywhere.
+
+         // public static ASTNULLType ASTNULL = new ASTNULLType
+
+
+      protected
+         fASTNULL    : TAST;
+
+
+
+         // Where did this rule leave off parsing;
+         // avoids a return parameter
+         fRetTree    : TAST;
+
+         fInputState : TTreeParserState;
+
+         // table of token type to token names
+         fTokenNames : TTokenNameMap;
+
+         // AST return value for a rule is squirreled away here
+         fRetAST     : TAST;
+
+         // AST support code; parser and tree parser delegate to this object
+         fASTFactory : TASTFactory;
+
+         // Used to keep track of indent depth for trace In/Out
+         fTraceDepth : integer;
+
+      protected
+         procedure   match(   ast   : TAST;
+                              typ   : integer);    overload;
+
+         procedure   match(   ast   : TAST;
+                              bits  : TByteSet);   overload;
+
+         procedure   matchNot(ast   : TAST;
+                              typ   : integer);
+
+
+
+      private
+         function    GetTokenName( i: integer): AnsiString;
+
+      public
+         procedure   AfterConstruction; override;
+         procedure   BeforeDestruction; override;
+
+      public
+         property    AST         : TAST         read  fRetAST;
+
+         property    ASTFactory  : TASTFactory  read  fASTFactory;
+
+         property    TokenName[i: integer]   : AnsiString      read  GetTokenName;
+         property    TokenNames              : TTokenNameMap   read  fTokenNames;
+
+   end;
+
+implementation
+uses
+   dpgrtl.exception,
+   System.SysUtils;
+
+{ TTreeParser }
+
+// ================================================================================================
+// After Construction
+// ================================================================================================
+procedure TTreeParser.AfterConstruction;
+begin
+   inherited;
+
+   fTraceDepth := 0;
+   fInputState := TTreeParserState  .Create;
+   fTokenNames := TTokenNameMap     .Create;
+   fASTFactory := TASTFactory       .Create(nil);
+end;
+
+// ================================================================================================
+// Before Destruction
+// ================================================================================================
+procedure TTreeParser.BeforeDestruction;
+begin
+   FreeAndNil( fTokenNames);
+   FreeAndNil( fInputState);
+   FreeAndNil( fASTFactory);
+   inherited
+end;
+
+// ================================================================================================
+// Get Token Name
+// ================================================================================================
+function TTreeParser.GetTokenName(i: integer): AnsiString;
+begin
+   result := '';
+
+   if Assigned(fTokenNames) then
+      fTokenNames.TryGetValue(i, result)
+end;
+
+// ================================================================================================
+// match( AST, type)
+// ================================================================================================
+procedure TTreeParser.match(ast: TAST; typ: integer);
+begin
+   // TODO: Exception creation check!
+
+   if (ast = nil) or (ast = fASTNULL) or (ast.AstType <> typ) then
+      raise Exception.Create('TREE: Mismatched token.');
+end;
+
+// ================================================================================================
+// match ( AST, byteset)
+//
+//    Make sure current lookahead symbol matches the given set.
+//    Throw an exception upon mismatch, which is catch by either the error handler or by the
+//    syntactic predicate.
+// ================================================================================================
+procedure TTreeParser.match(ast: TAST; bits: TByteSet);
+begin
+   if (ast = nil) or (ast = fASTNULL) or not (ast.AstType in bits) then
+      raise Exception.Create('TREE: Mismatched token.');
+end;
+
+// ================================================================================================
+// match not
+// ================================================================================================
+procedure TTreeParser.matchNot(ast: TAST; typ: integer);
+begin
+   if (ast = nil) or (ast = fASTNULL) or (ast.AstType = typ) then
+      raise Exception.Create('TREE: Mismatched token.');
+end;
+
+end.