Initial check in lib
This commit is contained in:
@@ -0,0 +1,554 @@
|
||||
unit dpglib.Tool;
|
||||
|
||||
interface
|
||||
uses
|
||||
System.Classes,
|
||||
System.SysUtils,
|
||||
dpgrtl.types,
|
||||
dpgrtl.exception,
|
||||
dpglib.Types;
|
||||
|
||||
type
|
||||
// =========================================================================
|
||||
// Class TTool declaration
|
||||
// =========================================================================
|
||||
TTool = class( TInterfacedObject,
|
||||
ITool)
|
||||
|
||||
protected
|
||||
fModuleStream : TStream;
|
||||
fModuleName : AnsiString;
|
||||
fOutputDir : AnsiString;
|
||||
fExchangeDir : AnsiString;
|
||||
fErrorHandler : IToolErrorHandler;
|
||||
|
||||
protected
|
||||
fWarningCount : integer;
|
||||
fErrorCount : integer;
|
||||
|
||||
protected
|
||||
// ------------------------------------------------------------
|
||||
// members
|
||||
// ------------------------------------------------------------
|
||||
fGrammarFile : AnsiString;
|
||||
fGrammar : IGrammar;
|
||||
|
||||
function GetWarningCount : integer;
|
||||
function GetErrorCount : integer;
|
||||
|
||||
// ------------------------------------------------------------
|
||||
// Exception handling
|
||||
// ------------------------------------------------------------
|
||||
procedure exMismatchedChar( mc: EMismatchedChar);
|
||||
procedure exMismatchedToken( mt: EMismatchedToken);
|
||||
|
||||
procedure dumpSets( pGrammar : IGrammar;
|
||||
pLexical : boolean;
|
||||
pSets : TInterfaceList;
|
||||
pDepth : integer);
|
||||
|
||||
public
|
||||
// ------------------------------------------------------------
|
||||
// Constructor/destructor
|
||||
// ------------------------------------------------------------
|
||||
constructor Create( pFile : AnsiString;
|
||||
pErrorHandler : IToolErrorHandler); overload;
|
||||
|
||||
constructor Create( pModuleStream : TStream;
|
||||
pModuleName : AnsiString;
|
||||
pOutputDir : AnsiString;
|
||||
pExchangeDir : AnsiString;
|
||||
pErrorHandler : IToolErrorHandler); overload;
|
||||
|
||||
destructor Destroy; override;
|
||||
|
||||
public
|
||||
// ------------------------------------------------------------
|
||||
// ITool methods
|
||||
// ------------------------------------------------------------
|
||||
procedure Go;
|
||||
function Get_ErrorHandler: IToolErrorHandler;
|
||||
|
||||
procedure Debug( pMessage : AnsiString);
|
||||
procedure Error( pMessage : AnsiString;
|
||||
pFileName: AnsiString = '';
|
||||
pLine : integer = 0;
|
||||
pColumn : integer = 0);
|
||||
|
||||
procedure Warning( pMessage : AnsiString;
|
||||
pFileName: AnsiString = '';
|
||||
pLine : integer = 0;
|
||||
pColumn : integer = 0);
|
||||
|
||||
procedure Panic( pMessage : AnsiString);
|
||||
|
||||
procedure WarnAltAmbiguity( pGrammar : IGrammar;
|
||||
pBlock : IAlternativeBlock;
|
||||
pLexical : boolean;
|
||||
pDepth : integer;
|
||||
pSets : TInterfaceList;
|
||||
pAltIdx1 : integer;
|
||||
pAltIdx2 : integer);
|
||||
|
||||
procedure WarnAltExitAmbiguity( pGrammar : IGrammar;
|
||||
pBlock : IBlockWithImpliedExitPath;
|
||||
pLexical : boolean;
|
||||
pDepth : integer;
|
||||
pSets : TInterfaceList;
|
||||
pAltIdx : integer);
|
||||
end;
|
||||
|
||||
implementation
|
||||
uses
|
||||
dpglib.DpgLexer,
|
||||
dpglib.DpgParser,
|
||||
dpglib.CodeGenerator,
|
||||
dpglib.Utils,
|
||||
dpglib.LLkAnalyzer,
|
||||
dpglib.GrammarMaker,
|
||||
dpglib.DelphiGenerator,
|
||||
dpglib.PrettyPrinter;
|
||||
// dpgExceptionPanic;
|
||||
|
||||
// ****************************************************************************
|
||||
//
|
||||
// Constructor/destructor
|
||||
//
|
||||
// ****************************************************************************
|
||||
// ============================================================================
|
||||
// Constructor
|
||||
// ============================================================================
|
||||
constructor TTool.Create( pFile : AnsiString;
|
||||
pErrorHandler : IToolErrorHandler);
|
||||
begin
|
||||
inherited Create;
|
||||
|
||||
fGrammar := nil;
|
||||
fGrammarFile := pFile;
|
||||
fErrorHandler := pErrorHandler;
|
||||
|
||||
fWarningCount := 0;
|
||||
fErrorCount := 0;
|
||||
end;
|
||||
|
||||
// ============================================================================
|
||||
// Constructor
|
||||
// ============================================================================
|
||||
constructor TTool.Create( pModuleStream : TStream;
|
||||
pModuleName : AnsiString;
|
||||
pOutputDir : AnsiString;
|
||||
pExchangeDir : AnsiString;
|
||||
pErrorHandler : IToolErrorHandler);
|
||||
begin
|
||||
fGrammar := nil;
|
||||
fWarningCount := 0;
|
||||
fErrorCount := 0;
|
||||
|
||||
fModuleStream := pModuleStream;
|
||||
fModuleName := pModuleName;
|
||||
fOutputDir := pOutputDir;
|
||||
fExchangeDir := pExchangeDir;
|
||||
fErrorHandler := pErrorHandler;
|
||||
end;
|
||||
|
||||
// ============================================================================
|
||||
// Destructor
|
||||
// ============================================================================
|
||||
destructor TTool.Destroy;
|
||||
begin
|
||||
fGrammar := nil;
|
||||
fErrorHandler := nil;
|
||||
|
||||
inherited;
|
||||
end;
|
||||
|
||||
// ****************************************************************************
|
||||
//
|
||||
// ITool implementation
|
||||
//
|
||||
// ****************************************************************************
|
||||
// ============================================================================
|
||||
// Go
|
||||
// ============================================================================
|
||||
procedure TTool.Go;
|
||||
var
|
||||
parser : TDpgParser;
|
||||
lexer : TDpgLexer;
|
||||
|
||||
gmaker : IGrammarBehavior;
|
||||
analyzer : ILLkAnalyzer;
|
||||
gen : ICodeGenerator;
|
||||
|
||||
begin
|
||||
fWarningCount := 0;
|
||||
fErrorCount := 0;
|
||||
|
||||
if (fModuleStream <> nil) and (fModuleName <> '') then
|
||||
begin
|
||||
try
|
||||
analyzer := TLLkAnalyzer .Create( self);
|
||||
gmaker := TGrammarMaker .Create( self, analyzer, fExchangeDir);
|
||||
gen := TDelphiGenerator .Create( fOutputDir, fExchangeDir);
|
||||
|
||||
lexer := TDpgLexer .Create( fModuleStream);
|
||||
parser := TDpgParser .Create( lexer, gmaker, self, fExchangeDir);
|
||||
|
||||
lexer.InputState.FileName := fModuleName;
|
||||
parser.InputState.FileName := fModuleName;
|
||||
|
||||
except
|
||||
if fErrorHandler <> nil then
|
||||
fErrorHandler.Error('Internal error');
|
||||
exit;
|
||||
end;
|
||||
|
||||
try
|
||||
parser.grammar;
|
||||
|
||||
except
|
||||
on mc: EMismatchedChar do begin exMismatchedChar( mc); exit; end;
|
||||
on mt: EMismatchedToken do begin exMismatchedToken(mt); exit; end;
|
||||
else
|
||||
begin
|
||||
if fErrorHandler <> nil then
|
||||
fErrorHandler.Error('Error: Unexpected exception...');
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
if fErrorCount = 0 then
|
||||
begin
|
||||
fGrammar := gmaker.Grammar;
|
||||
|
||||
try
|
||||
gen.Gen( gmaker.Grammar);
|
||||
|
||||
except
|
||||
if fErrorHandler <> nil then
|
||||
fErrorHandler.Error('Unexpected exception in generator');
|
||||
end;
|
||||
end
|
||||
end;
|
||||
end;
|
||||
|
||||
// ============================================================================
|
||||
// Get_ErrorHandler
|
||||
// ============================================================================
|
||||
function TTool.Get_ErrorHandler: IToolErrorHandler;
|
||||
begin
|
||||
result := nil;
|
||||
end;
|
||||
|
||||
// ============================================================================
|
||||
// Error
|
||||
// ============================================================================
|
||||
procedure TTool.Error( pMessage : AnsiString;
|
||||
pFileName: AnsiString;
|
||||
pLine : integer;
|
||||
pColumn : integer);
|
||||
var
|
||||
msg: AnsiString;
|
||||
|
||||
begin
|
||||
INC(fErrorCount);
|
||||
|
||||
if pColumn > 0
|
||||
then msg := pFileName +'(' +IntToStr(pLine) +',' +IntToStr(pColumn) +'): ' + pMessage
|
||||
else msg := pFileName +'(' +IntToStr(pLine) +'): ' + pMessage;
|
||||
|
||||
if fErrorHandler <> nil then
|
||||
fErrorHandler.Error( msg, pFileName, pLine, pColumn);
|
||||
end;
|
||||
|
||||
// ============================================================================
|
||||
// Warning
|
||||
// ============================================================================
|
||||
procedure TTool.Warning( pMessage : AnsiString;
|
||||
pFileName: AnsiString;
|
||||
pLine : integer;
|
||||
pColumn : integer);
|
||||
var
|
||||
msg: AnsiString;
|
||||
|
||||
begin
|
||||
INC(fWarningCount);
|
||||
|
||||
msg := pFileName + '(' + IntToStr( pLine) + '): ' + pMessage;
|
||||
if fErrorHandler <> nil then
|
||||
fErrorHandler.Warning( msg, pFileName, pLine, pColumn);
|
||||
end;
|
||||
|
||||
// ============================================================================
|
||||
// Panic
|
||||
// ============================================================================
|
||||
procedure TTool.Panic( pMessage : AnsiString);
|
||||
var
|
||||
msg: AnsiString;
|
||||
|
||||
begin
|
||||
msg := pMessage;
|
||||
if fErrorHandler <> nil then
|
||||
fErrorHandler.Panic( msg);
|
||||
|
||||
// Raise EPanic.Create(msg);
|
||||
end;
|
||||
|
||||
// ============================================================================
|
||||
// dumpSets
|
||||
// ============================================================================
|
||||
procedure TTool.dumpSets( pGrammar : IGrammar;
|
||||
pLexical : boolean;
|
||||
pSets : TInterfaceList;
|
||||
pDepth : integer);
|
||||
var
|
||||
i : integer;
|
||||
msg : AnsiString;
|
||||
la : ILookahead;
|
||||
|
||||
begin
|
||||
for i:=0 to pDepth-1 do
|
||||
begin
|
||||
la := pSets[i] as ILookahead;
|
||||
msg := Format(' k=%d ', [i+1]);
|
||||
|
||||
if la.LaSet = [] then
|
||||
msg := msg + '<EPS>'
|
||||
|
||||
else
|
||||
if pLexical
|
||||
then msg := msg + CharSetToStr( la.LaSet)
|
||||
else msg := msg + TokenSetToStr( la.LaSet, fGrammar.TokenManager);
|
||||
|
||||
fErrorHandler.Warning( msg);
|
||||
end;
|
||||
end;
|
||||
|
||||
// ============================================================================
|
||||
// WarnAltAmbiguity
|
||||
// ============================================================================
|
||||
procedure TTool.WarnAltAmbiguity( pGrammar : IGrammar;
|
||||
pBlock : IAlternativeBlock;
|
||||
pLexical : boolean;
|
||||
pDepth : integer;
|
||||
pSets : TInterfaceList;
|
||||
pAltIdx1 : integer;
|
||||
pAltIdx2 : integer);
|
||||
var
|
||||
rb: IRuleBlock;
|
||||
msg: AnsiString;
|
||||
ai : IAlternative;
|
||||
aj : IAlternative;
|
||||
rri : IRuleRefElem;
|
||||
rrj : IRuleRefElem;
|
||||
ri : AnsiString;
|
||||
rj : AnsiString;
|
||||
|
||||
begin
|
||||
if fErrorHandler = nil then
|
||||
exit;
|
||||
|
||||
pBlock.QueryInterface(IRuleBlock, rb);
|
||||
|
||||
|
||||
// ---------------------------------------------------------------
|
||||
// prepare locals
|
||||
// ---------------------------------------------------------------
|
||||
ai := pBlock.Alternative[pAltIdx1];
|
||||
aj := pBlock.Alternative[pAltIdx2];
|
||||
|
||||
ai.Head.QueryInterface(IRuleRefElem, rri);
|
||||
aj.Head.QueryInterface(IRuleRefElem, rrj);
|
||||
|
||||
// ---------------------------------------------------------------
|
||||
// Handle ambiguity of rules.
|
||||
// ---------------------------------------------------------------
|
||||
if (rb <> nil) and
|
||||
(rri <> nil) and
|
||||
(rrj <> nil) and
|
||||
(pLexical) and
|
||||
pBlock.AutoGen then
|
||||
begin
|
||||
ri := TCodeGenerator.decodeLexerRuleName( rri.TargetRule);
|
||||
rj := TCodeGenerator.decodeLexerRuleName( rrj.TargetRule);
|
||||
msg := fGrammarFile +'(1): ';
|
||||
|
||||
fErrorHandler.Warning('');
|
||||
msg := msg + 'Lexical nondeterminism between rules "' +
|
||||
ri + '" and "' + rj + '"';// upon:';
|
||||
|
||||
fErrorHandler.Warning( msg);
|
||||
end
|
||||
|
||||
// ---------------------------------------------------------------
|
||||
// Handle ambiguity of alternatives.
|
||||
// ---------------------------------------------------------------
|
||||
else
|
||||
begin
|
||||
|
||||
fErrorHandler.Warning('');
|
||||
msg := pGrammar.GrammarFile (*fGrammarFile*) + '(' +
|
||||
IntToStr( pBlock.Line) + '): ';
|
||||
|
||||
if pLexical then
|
||||
msg := msg + 'lexical ';
|
||||
|
||||
msg := msg + 'nondeterminism between alts ' +
|
||||
IntToStr( pAltIdx1+1) + ' and ' + IntToStr( pAltIdx2+1) +
|
||||
' of block in rule "' + pBlock.EnclosingRule + '"';// upon:';
|
||||
|
||||
fErrorHandler.Warning( msg);
|
||||
end;
|
||||
|
||||
dumpSets( pGrammar, pLexical, pSets, pDepth);
|
||||
end;
|
||||
|
||||
// ============================================================================
|
||||
// WarnAltExitAmbiguity
|
||||
// ============================================================================
|
||||
procedure TTool.WarnAltExitAmbiguity( pGrammar : IGrammar;
|
||||
pBlock : IBlockWithImpliedExitPath;
|
||||
pLexical : boolean;
|
||||
pDepth : integer;
|
||||
pSets : TInterfaceList;
|
||||
pAltIdx : integer);
|
||||
var
|
||||
fileline : AnsiString;
|
||||
msg : AnsiString;
|
||||
|
||||
begin
|
||||
if fErrorHandler <> nil then
|
||||
begin
|
||||
fileline := fGrammarFile + '(' + IntToStr( pBlock.Line) + '):';
|
||||
|
||||
msg := fileline;
|
||||
|
||||
if pLexical then
|
||||
msg := msg + 'lexical';
|
||||
|
||||
msg := msg +' nondeterminism between alt ' + IntToStr( pAltIdx) +
|
||||
' and exit branch of block in rule ' + pBlock.EnclosingRule + '.';
|
||||
|
||||
fErrorHandler.Warning('');
|
||||
fErrorHandler.Warning(msg);
|
||||
dumpSets( pGrammar, pLexical, pSets, pDepth);
|
||||
end;
|
||||
end;
|
||||
|
||||
// ============================================================================
|
||||
// Debug
|
||||
// ============================================================================
|
||||
procedure TTool.Debug(pMessage: AnsiString);
|
||||
begin
|
||||
if fErrorHandler <> nil then
|
||||
fErrorHandler.Error(pMessage);
|
||||
end;
|
||||
|
||||
// ============================================================================
|
||||
// exMismatchedChar
|
||||
//
|
||||
// Handle lexer mismatched char exception.
|
||||
// ============================================================================
|
||||
procedure TTool.exMismatchedChar(mc: EMismatchedChar);
|
||||
var
|
||||
msg : AnsiString;
|
||||
filename : AnsiString;
|
||||
begin
|
||||
fileName := ExtractFileName(mc.FileName);
|
||||
|
||||
// ---------------------------------------------------------------
|
||||
// Handle AnsiString
|
||||
// ---------------------------------------------------------------
|
||||
if mc.FoundString <> '' then
|
||||
msg := 'Unexpected AnsiString token: ' + mc.FoundString
|
||||
|
||||
// ---------------------------------------------------------------
|
||||
// Handle char
|
||||
// ---------------------------------------------------------------
|
||||
else
|
||||
begin
|
||||
if not mc.Inverted then
|
||||
msg := 'Expecting [' + CharSetToStr( mc.CharSet) + '] but found ' +
|
||||
CharSetToStr([mc.FoundChar])
|
||||
else
|
||||
msg := 'Not expecting [' + CharSetToStr( mc.CharSet) + '] and found ' +
|
||||
CharSetToStr([mc.FoundChar])
|
||||
end;
|
||||
|
||||
Error( msg, fileName, mc.Line, mc.Column);
|
||||
(*
|
||||
// ---------------------------------------------------------------
|
||||
// Unexpected AnsiString, AnsiString
|
||||
// ---------------------------------------------------------------
|
||||
if mc.ExpCode = EC_CHAR then
|
||||
msg := 'Unexpected token: ' + CharSetToStr([mc.FoundChar])
|
||||
|
||||
// ---------------------------------------------------------------
|
||||
// Unexpected char, charset
|
||||
// ---------------------------------------------------------------
|
||||
else if mc.ExpCode = EC_CHARSET then
|
||||
if not mc.Invert then
|
||||
msg := 'Expecting [' + CharSetToStr( mc.CharSet) + '] but found ' +
|
||||
CharSetToStr([mc.FoundChar])
|
||||
else
|
||||
msg := 'Not expecting [' + CharSetToStr( mc.CharSet) + '] and found ' +
|
||||
CharSetToStr([mc.FoundChar])
|
||||
|
||||
// ---------------------------------------------------------------
|
||||
// Unexpected char, char range
|
||||
// ---------------------------------------------------------------
|
||||
else if mc.ExpCode = EC_CHARRANGE then
|
||||
if not mc.Invert then
|
||||
msg := 'Expecting [' + CharSetToStr( mc.CharSet) + '] but found ' +
|
||||
CharSetToStr([mc.FoundChar])
|
||||
else
|
||||
msg := 'Not expecting [' + CharSetToStr( mc.CharSet) + '] and found ' +
|
||||
CharSetToStr([mc.FoundChar])
|
||||
|
||||
// ---------------------------------------------------------------
|
||||
// Unexpected AnsiString
|
||||
// ---------------------------------------------------------------
|
||||
else if mc.ExpCode = EC_STRING then
|
||||
msg := 'Unexpected AnsiString token: ' + mc.FoundStr
|
||||
|
||||
// ---------------------------------------------------------------
|
||||
// Something wrong...
|
||||
// ---------------------------------------------------------------
|
||||
else
|
||||
msg := 'Internal error: Unknown lexer exception.';
|
||||
|
||||
Error( msg, fileName, mc.Line, mc.Column);
|
||||
*)
|
||||
end;
|
||||
|
||||
// ============================================================================
|
||||
// exMismatchedToken
|
||||
//
|
||||
// Handle parser mismatched token exception.
|
||||
//
|
||||
// Note: the member fGrammar now valid at this point, so we can use the
|
||||
// grammar's token manager.
|
||||
// ============================================================================
|
||||
procedure TTool.exMismatchedToken(mt: EMismatchedToken);
|
||||
var
|
||||
fileName : string;
|
||||
msg : string;
|
||||
|
||||
begin
|
||||
fileName := ExtractFileName( mt.FileName);
|
||||
msg := 'Unexpected token: ' + mt.FoundToken.TokenText;
|
||||
|
||||
Error( msg, fileName, mt.Line, mt.Column);
|
||||
end;
|
||||
|
||||
|
||||
function TTool.GetErrorCount: integer;
|
||||
begin
|
||||
result := fErrorCount;
|
||||
end;
|
||||
|
||||
function TTool.GetWarningCount: integer;
|
||||
begin
|
||||
result := fWarningCount;
|
||||
end;
|
||||
|
||||
end.
|
||||
Reference in New Issue
Block a user