148 lines
4.5 KiB
ObjectPascal
148 lines
4.5 KiB
ObjectPascal
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.
|