bds.mr.dpg/src.lib/dpglib.Grammar.pas

unit dpglib.Grammar;

interface
uses
   System.Classes,
   System.Contnrs,
   dpgrtl.types,
   dpglib.Types;

type
   TGrammar = class( TInterfacedObject, IGrammar)

   protected
      fCharVocabulary   : TByteSet;
      fTool             : ITool;
      fGenerator        : ICodeGenerator;
      fAnalyzer         : ILLkAnalyzer;
      fRules            : TInterfaceList;
      fMaxK             : integer;
      fSymbols          : TStringList; //???
      fUses             : TStringList;
      fUses2            : TStringList;

      fConst            : IToken;
      fType             : IToken;

      fAnalyzerDebug    : boolean;
      fInteractive      : boolean;
      fHasSynPred       : boolean;
      fHasErrHandling   : boolean;

      fFileName         : AnsiString;
      fUnitName         : AnsiString;
      fGrammarName      : AnsiString;
      fSuperName        : AnsiString;
      fGrammarFile      : AnsiString;

      fTokenManager     : ITokenManager;

      fImportVocab      : IToken;
      fExportVocab      : AnsiString;

      fTraceRules       : boolean;
      fDebugOutput      : boolean;
      fDefErrorHandler  : boolean;

      fMemberAction     : IToken;
      fMemberDecl       : AnsiString;
      fMemberDef        : AnsiString;


   public
      // ------------------------------------------------------------
      // Constructor/destructor
      // ------------------------------------------------------------
      constructor Create(     pObjectName    : IToken;
                              pTool          : ITool;
                              pSuperName     : IToken);
      destructor  Destroy; override;

      // ------------------------------------------------------------
      // IGrammar methods
      // ------------------------------------------------------------
      function    GetImportVocab   : IToken;               virtual;
      function    GetExportVocab   : AnsiString;           virtual;

      procedure   SetImportVocab( pVocab   : IToken);      virtual;
      procedure   SetExportVocab( pVocab   : AnsiString);  virtual;

      procedure   Generate;                                virtual; abstract;

      function    GetFileName         : AnsiString;
      function    GetUnitName         : AnsiString;
      function    GetObjectName       : AnsiString;
      function    GetGrammarName      : AnsiString;
      function    GetSuperName        : AnsiString;
      function    GetMaxK             : integer;
      function    GetTool             : ITool;
      function    GetAnalyzer         : ILLkAnalyzer;
      function    GetCodeGenerator    : ICodeGenerator;
      function    GetTokenManager     : ITokenManager;
      function    GetHasSynPred       : boolean;
      function    GetMemberAction     : IToken;
      function    GetCharVocabulary   : TByteSet;
      function    GetRules            : TInterfaceList;
      function    GetUsesList         : TStringList;
      function    GetUsesList2        : TStringList;

      function    GetMemberDecl       : AnsiString;
      function    GetMemberDef        : AnsiString;

      function    GetConstAction      : IToken;
      function    GetTypeAction       : IToken;
      function    GetGrammarFile   : AnsiString;

      function    GetDefErrorHandler  : boolean;

//      function    GetDefined(   pID   : AnsiString): boolean;
      function    GetSymbol(    pRule : AnsiString): ITokenSymbol;

      procedure   SetUnitName(        pUnit          : AnsiString);
      procedure   SetAnalyzer(        pAnalyzer      : ILLkAnalyzer);
      procedure   SetTokenManager(    pTokenManager  : ITokenManager);
      procedure   SetDefErrorHandler( pHandler       : boolean);
      procedure   SetHasSynPred(      pHasSynPred    : boolean);
      procedure   SetMemberAction(    pAction        : IToken);
      procedure   SetCharVocabulary(  pVocab         : TByteSet);

      procedure   SetMemberDecl(      pDecl          : AnsiString);
      procedure   SetMemberDef(       pDef           : AnsiString);
      procedure   SetConstAction(     pConst         : IToken);
      procedure   SetTypeAction(      pType          : IToken);

      procedure   SetCodeGenerator(   pGenerator     : ICodeGenerator);
      procedure   SetGrammarFile(           pFile    : AnsiString);

      procedure   Define(     pSymbol: IRuleSymbol);
      function    SetOption(  pOption: IToken; pValue: IToken): boolean; virtual;

      function    GetClassName: AnsiString;
      function    Defined( pID: AnsiString): boolean;
   end;


implementation
uses
   System.SysUtils,
   dpglib.TokenLexer,
   dpglib.TokenParser,
   dpglib.TokenManager,
   dpglib.Messages;

// @@@: Construction/destruction ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
//
//                                   Construction/destruction
//
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ================================================================================================
// Constructor
// ================================================================================================
constructor TGrammar.Create(  pObjectName : IToken;
                              pTool       : ITool;
                              pSuperName  : IToken);
begin
   inherited Create;

   fGrammarName := pObjectName.TokenText;
   fTool        := pTool;

   if pSuperName <> nil then
      fSuperName := pSuperName.TokenText
   else
      fSuperName := '';


   fTokenManager     := TTokenManager.Create( 'TokenManager', pTool);
   fRules            := TInterfaceList.Create;
   fSymbols          := TStringList.Create;

   fDefErrorHandler  := false;
   fMemberDecl       := '';
   fMemberDef        := '';

   fConst            := nil;
   fType             := nil;

   fImportVocab      := nil;
   fExportVocab      := '';

   fCharVocabulary   := [1..255];
   fMaxK             := 1;

   // ---------------------------------------------------------------
   // Prepare uses list for interface section
   // ---------------------------------------------------------------
   fUses             := TStringList.Create;
   fUses.Sorted      := true;
   fUses.Duplicates  := dupIgnore;

   fUses.Add(  'Classes'         );
   fUses.Add(  'SysUtils'        );
   fUses.Add(  'dpgrtl.types'  );

   if Supports( self, ILexerGrammar)  then fUses.Add( 'dpgrtl.lexer') else
   if Supports( self, IParserGrammar) then fUses.Add( 'dpgrtl.llkparser');

   // ---------------------------------------------------------------
   // Prepare uses list for implementation section
   // ---------------------------------------------------------------
   fUses2            := TStringList.Create;
   fUses2.Sorted     := true;
   fUses2.Duplicates := dupIgnore;

   fUses2.Add( 'dpgrtl.exception' );
   fUses2.Add( 'dpgrtl.token'     );

//   if Supports( self, ILexerGrammar) then fUses2.Add( 'dpgrtl.token');
end;

// ----------------------------------------------------------------------------
// Destructor
// ----------------------------------------------------------------------------
destructor TGrammar.Destroy;
begin
   fConst   := nil;
   fType    := nil;

   FreeAndNil( fUses);
   FreeAndNil( fUses2);
   FreeAndNil( fSymbols);
   FreeAndNil( fRules);

   fTokenManager := nil;

   inherited;
end;

// ****************************************************************************
//                                                   IGrammar implementation
// ****************************************************************************
// ----------------------------------------------------------------------------
// Define
// ----------------------------------------------------------------------------
procedure TGrammar.Define(pSymbol: IRuleSymbol);
begin
   fRules.Add( pSymbol);
   fSymbols.AddObject( pSymbol.ID, pointer( pSymbol));
end;

// ----------------------------------------------------------------------------
// GetObjectName
// ----------------------------------------------------------------------------
function TGrammar.GetObjectName: AnsiString;
begin
   result := fGrammarName;
end;

// ----------------------------------------------------------------------------
// GetSuperName
// ----------------------------------------------------------------------------
function TGrammar.GetSuperName: AnsiString;
begin
   result := fSuperName;
end;

// ----------------------------------------------------------------------------
// GetMaxK
// ----------------------------------------------------------------------------
function TGrammar.GetMaxK: integer;
begin
   result := fMaxK;
end;

// ----------------------------------------------------------------------------
// GetAnalyzer
// ----------------------------------------------------------------------------
function TGrammar.GetAnalyzer: ILLkAnalyzer;
begin
   result := fAnalyzer;
end;

// ----------------------------------------------------------------------------
// GetDefErrorHandler
// ----------------------------------------------------------------------------
function TGrammar.GetDefErrorHandler: boolean;
begin
   result := fDefErrorHandler;
end;

// ----------------------------------------------------------------------------
// GetFileName
// ----------------------------------------------------------------------------
function TGrammar.GetFileName: AnsiString;
begin
   result := fFileName;
end;

// ----------------------------------------------------------------------------
// GetSymbol
// ----------------------------------------------------------------------------
function TGrammar.GetSymbol(pRule: AnsiString): ITokenSymbol;
var
   idx: integer;

begin
   idx := fSymbols.IndexOf( prule);

   if idx >= 0 then
      result := ITokenSymbol( pointer(fSymbols.Objects[idx]))
   else
      result := nil;
end;

// ----------------------------------------------------------------------------
// GetDefined
// ----------------------------------------------------------------------------
//function TGrammar.GetDefined(pID: AnsiString): boolean;
//begin
//end;

// ----------------------------------------------------------------------------
// SetAnalyzer
// ----------------------------------------------------------------------------
procedure TGrammar.SetAnalyzer(pAnalyzer: ILLkAnalyzer);
begin
   fAnalyzer   := pAnalyzer;
end;

// ----------------------------------------------------------------------------
// SetTokenManager
// ----------------------------------------------------------------------------
procedure TGrammar.SetTokenManager(pTokenManager: ITokenManager);
begin
   fTokenManager := pTokenManager;
end;

// ============================================================================
// SetOption
//
// Option               Value
// -------------------------------------------------------
// k                    integer
// defaultErrorHandler  true/false
// ============================================================================
function TGrammar.SetOption(pOption, pValue: IToken): boolean;
var
   k: integer;
   s: AnsiString;
begin
   result := true;

   // ---------------------------------------------------------------
   // Option: k
   // ---------------------------------------------------------------
   if pOption.TokenText = 'k' then
   begin
      k := StrToIntDef( pValue.TokenText, -1);
      if k < 1 then
      begin
         fTool.Error('option "k" must be a positive integer',
                     fGrammarFile,
                     pValue.TokenLine,
                     pValue.TokenColumn);
         result := false;
      end
      else
         fMaxK := k;
   end

   // ---------------------------------------------------------------
   // Option: defaultErrorHandler
   // ---------------------------------------------------------------
   else if pOption.TokenText = 'defaultErrorHandler' then
   begin
      if pValue.TokenText = 'true' then
         fDefErrorHandler := true

      else if pValue.TokenText = 'false' then
         fDefErrorHandler := false

      else
      begin
         fTool.Error('Value for "defaultErrorHandler" must be true or false.',
                     fGrammarFile,
                     pValue.TokenLine,
                     pValue.TokenColumn);

         result := false;
      end;
   end

   else
   begin
      s := MSG_W_ILLEGALOPTION;

      fTool.Warning( Format(  MSG_W_ILLEGALOPTION, [pOption.TokenText]),
                  fGrammarFile,
                  pValue.TokenLine,
                  pValue.TokenColumn);

      result := false;
   end;
end;

function TGrammar.GetTool: ITool;
begin
   result := fTool;
end;

function TGrammar.GetCodeGenerator: ICodeGenerator;
begin
   result := fGenerator;
end;

function TGrammar.GetTokenManager: ITokenManager;
begin
   result := fTokenManager;
end;

function TGrammar.GetHasSynPred: boolean;
begin
   result := fHasSynPred;
end;

function TGrammar.GetMemberAction: IToken;
begin
   result := fMemberAction;
end;

procedure TGrammar.SetDefErrorHandler(pHandler: boolean);
begin
   fDefErrorHandler := fDefErrorHandler;
end;

procedure TGrammar.SetHasSynPred(pHasSynPred: boolean);
begin
   fHasSynPred := pHasSynPred;
end;

procedure TGrammar.SetMemberAction(pAction: IToken);
begin
   fMemberAction := pAction;
end;

function TGrammar.GetClassName: AnsiString;
begin
   result := fGrammarName;
end;

function TGrammar.Defined(pID: AnsiString): boolean;
begin
   if fSymbols.IndexOf( pID) >= 0 then
      result := true
   else
      result := false;
end;

function TGrammar.GetCharVocabulary: TByteSet;
begin
   result := fCharVocabulary;
end;

procedure TGrammar.SetCharVocabulary(pVocab: TByteSet);
begin
   fCharVocabulary := pVocab;
end;


// ============================================================================
// GetUnitName
// ============================================================================
function TGrammar.GetUnitName: AnsiString;
begin
   result := fUnitName;
end;

// ============================================================================
// SetUnitName
// ============================================================================
procedure TGrammar.SetUnitName(pUnit: AnsiString);
begin
   fUnitName      := pUnit;
   fFileName      := pUnit + '.pas';
//   fExportVocab   := pUnit;
end;

// ----------------------------------------------------------------------------
// ----------------------------------------------------------------------------
function TGrammar.GetGrammarName: AnsiString;
begin
   result := fGrammarName;
end;

// ----------------------------------------------------------------------------
// ----------------------------------------------------------------------------
function TGrammar.GetRules: TInterfaceList;
begin
   result := fRules;
end;


// ----------------------------------------------------------------------------
// GetUsesList
// ----------------------------------------------------------------------------
function TGrammar.GetUsesList: TStringList;
begin
   result := fUses;
end;

function TGrammar.GetUsesList2: TStringList;
begin
   result := fUses2;
end;


function TGrammar.GetMemberDecl: AnsiString;
begin
   result := fMemberDecl;
end;

function TGrammar.GetMemberDef: AnsiString;
begin
   result := fMemberDef;
end;

procedure TGrammar.SetMemberDecl(pDecl: AnsiString);
begin
   fMemberDecl := pDecl;
end;

procedure TGrammar.SetMemberDef(pDef: AnsiString);
begin
   fMemberDef  := pDef;
end;

procedure TGrammar.SetCodeGenerator(pGenerator: ICodeGenerator);
begin
   fGenerator := pGenerator;
end;

// ============================================================================
// GetImportVocab
// ============================================================================
function TGrammar.GetImportVocab: IToken;
begin
   result := fImportVocab;
end;

// ============================================================================
// GetExportVocab
// ============================================================================
function TGrammar.GetExportVocab: AnsiString;
begin
   result := fExportVocab;
end;

// ============================================================================
// SetImportVocab
// ============================================================================
procedure TGrammar.SetImportVocab(pVocab: IToken);
var
   stream   : TFileStream;
   lexer    : ITokenStream;
   parser   : TTokenParser;
   fname    : AnsiString;

begin
   if fImportVocab = nil then
   begin


      try
         fImportVocab   := pVocab;
         fname          := pVocab.TokenText + 'Tokens.txt';
         stream         := TFileStream.Create( fName, fmOpenRead);
      except


         fTool.Warning( Format(  MSG_W_CANTIMPORT, [fname]),
                        fGrammarFile,
                        pVocab.TokenLine,
                        pVocab.TokenColumn);

         fImportVocab   := nil;
         stream         := nil;
      end;


      if stream <> nil then
      begin
         lexer    := TTokenLexer.Create( stream);
         parser   := TTokenParser.Create(lexer);

         try
            parser.tokenFile( fTokenManager);
         except
         end;

         FreeAndNil( stream);
      end;
   end;
end;

// ============================================================================
// SetExportVocab
// ============================================================================
procedure TGrammar.SetExportVocab(pVocab: AnsiString);
begin
   fExportVocab := pVocab;
end;

function TGrammar.GetConstAction: IToken;
begin
   result := fConst;
end;

function TGrammar.GetTypeAction: IToken;
begin
   result := fType;
end;

procedure TGrammar.SetConstAction(pConst: IToken);
begin
   fConst := pConst;
end;

procedure TGrammar.SetTypeAction(pType: IToken);
begin
   fType := pType;
end;

function TGrammar.GetGrammarFile: AnsiString;
begin
   result := fGrammarFile;
end;

procedure TGrammar.SetGrammarFile(pFile: AnsiString);
begin
   fGrammarFile := pFile;
end;

end.