555 lines
18 KiB
ObjectPascal
555 lines
18 KiB
ObjectPascal
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.
|