unit dpglib.RuleBlock;

interface
uses
   System.Classes,
   dpgrtl.types,
   dpglib.Types,
   dpglib.Lookahead,
   dpglib.AlternativeBlock;

type
   // =========================================================================
   // TRuleBlock class specification
   // =========================================================================
   TRuleBlock = class(  TAlternativeBlock,
                        IRuleBlock,
                        IAlternativeBlock,
                        IAlternativeElem,
                        IGrammarElem)
   // ---------------------------------------------------------------
   // Members
   // ---------------------------------------------------------------
   protected
      fRuleName         : AnsiString;
      fArguments        : AnsiString;
      fThrowSpec        : AnsiString;
      fReturnAction     : AnsiString;
      fLocals           : AnsiString;
      fIgnoreRule       : AnsiString;

      fExHandlerType    : AnsiString;
      fExHandlerCode    : AnsiString;

      fEndNode          : IRuleEndElem;

      fLock             : array of boolean;
      fCache            : array of ILookahead;

      fTestLiterals     : boolean;
      fDefErrorHandler  : boolean;

      fLabeledElems     : TInterfaceList;
      fOneOrMoreBlocks  : TInterfaceList;
      fNMBlocks         : TInterfaceList;
      fSynPredBlocks    : TInterfaceList;

   // ---------------------------------------------------------------
   // Internals
   // ---------------------------------------------------------------
//   protected
//      function    FindExceptionSpec( pSpec: AnsiString)   : IExceptionSpec; overload;
//      function    FindExceptionSpec( pSpec: IToken): IExceptionSpec; overload;


   // ---------------------------------------------------------------
   // Constructor/destructor
   // ---------------------------------------------------------------
   public
      constructor Create(     pGrammar    : IGrammar;
                              pID         : AnsiString);        overload;
      constructor Create(     pGrammar    : IGrammar;
                              pID         : AnsiString;
                              pLine       : integer;
                              pDoAutoGen  : boolean);       overload;


      destructor  Destroy; override;

   // ---------------------------------------------------------------
   // IGrammarElem overrides
   // ---------------------------------------------------------------
   public
      procedure   Generate;                       
      function    Look( pK: integer): ILookahead; 
      function    AsString          : AnsiString; 

   // ---------------------------------------------------------------
   // IAlternativeBlock overrides
   // ---------------------------------------------------------------
   public
      procedure   PrepareForAnalysis; override;

   // ---------------------------------------------------------------
   // IRuleBlock methods
   // ---------------------------------------------------------------
   protected
      function    GetRuleName         : AnsiString;
      function    GetArguments        : AnsiString;
      function    GetThrowSpec        : AnsiString;
      function    GetReturnAction     : AnsiString;
      function    GetLocals           : AnsiString;
      function    GetEndNode          : IRuleEndElem;

      function    GetTestLiterals     : boolean;
      function    GetLabeledElems     : TInterfaceList;

      function    GetExHandlerType    : AnsiString;
      function    GetExHandlerCode    : AnsiString;

      function    GetDefErrorHandler  : boolean;
      function    GetIgnoreRule       : AnsiString;
      function    GetOneOrMoreBlocks  : TInterfaceList;
      function    GetNMBlocks        : TInterfaceList;
      function    GetSynPredBlocks    : TInterfaceList;

      function    GetLock( i: integer): boolean;
      function    GetCache(i: integer): ILookahead;

      procedure   SetRuleName(        pRuleName      : AnsiString);
      procedure   SetArguments(       pArguments     : AnsiString);
      procedure   SetThrowSpec(       pThrowSpec     : AnsiString);
      procedure   SetReturnAction(    pAction        : AnsiString);
      procedure   SetLocals(          pLocals        : AnsiString);
      procedure   SetEndNode(         pNode          : IRuleEndElem);

      procedure   SetTestLiterals(    pTestLiterals  : boolean);
      procedure   SetLabeledElems(    pLabeledElems  : TInterfaceList);

      procedure   SetExHandlerType(   pExType        : AnsiString);
      procedure   SetExHandlerCode(   pExCode        : AnsiString);
      
      procedure   SetDefErrorHandler( pErrorHandler  : boolean);
      procedure   SetIgnoreRule(      pRule          : AnsiString);

      procedure   SetLock( i:integer; pLock          : boolean);
      procedure   SetCache(i:integer; pCache         : ILookahead);

   public
      procedure   AddExceptionSpec(    pExceptionSpec : IExceptionSpec);
      procedure   SetOption(           pKey, pValue   : IToken);
      function    IsLexerAutoGenRule: boolean;
   end;

implementation
uses
   System.SysUtils,
   dpglib.Messages;

// ****************************************************************************
//                                                       Constructor/destructor
// ****************************************************************************
// ============================================================================
// Constructor
// ============================================================================
constructor TRuleBlock.Create(pGrammar: IGrammar; pID: AnsiString);
var
   pg: IParserGrammar;

begin
   inherited Create( pGrammar);

   fRuleName         := pID;
   fLabeledElems     := TInterfaceList.Create;
   fOneOrMoreBlocks  := TInterfaceList.Create;
   fNMBlocks         := TInterfaceList.Create;
   fSynPredBlocks    := TInterfaceList.Create;
   fLine             := 0;

   SetLength( fCache, fGrammar.MaxK +1);

   if fGrammar.QueryInterface(IParserGrammar, pg) = S_OK then
      fDoAutoGen := true;
end;

// ============================================================================
// Constructor
// ============================================================================
constructor TRuleBlock.Create(   pGrammar    : IGrammar;
                                    pID         : AnsiString;
                                    pLine       : integer;
                                    pDoAutoGen  : boolean);
begin
   inherited Create( pGrammar);

   fRuleName         := pID;
   fLabeledElems     := TInterfaceList.Create;
   fDoAutoGen        := pDoAutoGen;
   fOneOrMoreBlocks  := TInterfaceList.Create;
   fNMBlocks        := TInterfaceList.Create;
   fSynPredBlocks    := TInterfaceList.Create;
   fLine             := pLine;

   SetLength( fCache, fGrammar.MaxK +1);
end;

// ============================================================================
// Destructor
// ============================================================================
destructor TRuleBlock.Destroy;
var
   i : integer;

begin
   FreeAndNil( fLabeledElems);
   FreeAndNil( fOneOrMoreBlocks);
   FreeAndNil( fNMBlocks);
   FreeAndNil( fSynPredBlocks);

   for i:=Low(fCache) to High(fCache) do
      fCache[i] := nil;

   fCache := nil;
   inherited;
end;

// ****************************************************************************
//                                                    IGrammarElem overrides
// ****************************************************************************
// ============================================================================
// Generate
// ============================================================================
procedure TRuleBlock.Generate;
begin
   fGrammar.Generator.Gen( self);
end;

// ============================================================================
// Look
// ============================================================================
function TRuleBlock.Look(pK: integer): ILookahead;
begin
   result := fGrammar.LLkAnalyzer.Look( pK, self);
end;

// ============================================================================
// AsString
// ============================================================================
function TRuleBlock.AsString: AnsiString;
begin
   result := '';
end;

// ****************************************************************************
//                                               IAlternativeBlock overrides
// ****************************************************************************
// ============================================================================
// PrepareForAnalysis
// ============================================================================
procedure TRuleBlock.PrepareForAnalysis;
begin
  inherited;

  SetLength( fLock, fGrammar.MaxK +1);
end;

// ****************************************************************************
//                                                 IRuleBlock implementation
// ****************************************************************************
// ============================================================================
// GetArguments
// ============================================================================
function TRuleBlock.GetArguments: AnsiString;
begin
   result := fArguments;
end;

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

// ============================================================================
// GetEndNode
// ============================================================================
function TRuleBlock.GetEndNode: IRuleEndElem;
begin
   result := fEndNode;
end;

// ============================================================================
// GetIgnoreRule
// ============================================================================
function TRuleBlock.GetIgnoreRule: AnsiString;
begin
   result := fIgnoreRule;
end;

// ============================================================================
// GetLock
// ============================================================================
function TRuleBlock.GetLock(i: integer): boolean;
begin
   result := fLock[i];
end;

// ============================================================================
// GetCache
// ============================================================================
function TRuleBlock.GetCache(i: integer): ILookahead;
begin
   result := fCache[i];
end;

// ============================================================================
// GetLabeledElems
// ============================================================================
function TRuleBlock.GetLabeledElems: TInterfaceList;
begin
   result := fLabeledElems;
end;

// ============================================================================
// GetReturnAction
// ============================================================================
function TRuleBlock.GetReturnAction: AnsiString;
begin
   result := fReturnAction;
end;

// ============================================================================
// GetLocals
// ============================================================================
function TRuleBlock.GetLocals: AnsiString;
begin
   result := fLocals;
end;

// ============================================================================
// GetRuleName
// ============================================================================
function TRuleBlock.GetRuleName: AnsiString;
begin
   result := fRuleName;
end;

// ============================================================================
// GetTestLiterals
// ============================================================================
function TRuleBlock.GetTestLiterals: boolean;
begin
   result := fTestLiterals;
end;

// ============================================================================
// GetThrowSpec
// ============================================================================
function TRuleBlock.GetThrowSpec: AnsiString;
begin
   result := fThrowSpec;
end;

// ============================================================================
// SetArguments
// ============================================================================
procedure TRuleBlock.SetArguments(pArguments: AnsiString);
begin
   fArguments := pArguments;
end;

// ============================================================================
// SetDefErrorHandler
// ============================================================================
procedure TRuleBlock.SetDefErrorHandler(pErrorHandler: boolean);
begin
   fDefErrorHandler := pErrorHandler;
end;

// ============================================================================
// SetEndNode
// ============================================================================
procedure TRuleBlock.SetEndNode(pNode: IRuleEndElem);
begin
   fEndNode := pNode;
end;

// ============================================================================
// SetIgnoreRule
// ============================================================================
procedure TRuleBlock.SetIgnoreRule(pRule: AnsiString);
begin
   fIgnoreRule := pRule;
end;

// ============================================================================
// SetLock
// ============================================================================
procedure TRuleBlock.SetLock(i: integer; pLock: boolean);
begin
   fLock[i] := pLock;
end;

// ============================================================================
// SetCache
// ============================================================================
procedure TRuleBlock.SetCache(i: integer; pCache: ILookahead);
begin
   fCache[i] := pCache;
end;

// ============================================================================
// SetLabeledElems
// ============================================================================
procedure TRuleBlock.SetLabeledElems(pLabeledElems: TInterfaceList);
begin
   FreeAndNil( fLabeledElems);
   fLabeledElems := pLabeledElems;
end;

// ============================================================================
// SetReturnAction
// ============================================================================
procedure TRuleBlock.SetReturnAction(pAction: AnsiString);
begin
   fReturnAction := pAction;
end;

// ============================================================================
// SetLocals
// ============================================================================
procedure TRuleBlock.SetLocals(pLocals: AnsiString);
begin
   fLocals := pLocals;
end;

// ============================================================================
// SetRuleName
// ============================================================================
procedure TRuleBlock.SetRuleName(pRuleName: AnsiString);
begin
   fRuleName := pRuleName;
end;

// ============================================================================
// SetTestLiterals
// ============================================================================
procedure TRuleBlock.SetTestLiterals(pTestLiterals: boolean);
begin
   fTestLiterals := pTestLiterals;
end;

// ============================================================================
// SetThrowSpec
// ============================================================================
procedure TRuleBlock.SetThrowSpec(pThrowSpec: AnsiString);
begin
   fThrowSpec := pThrowSpec;
end;

// ============================================================================
// AddExceptionSpec
// ============================================================================
procedure TRuleBlock.AddExceptionSpec( pExceptionSpec: IExceptionSpec);
begin
(*
   if FindExceptionSpec( pExceptionSpec.Lbl.TokenText) <> nil then
   begin
      if pExceptionSpec.Lbl.TokenText <> '' then
         fGrammar.Tool.Error( 'Rule "' + fRuleName + '" already has an exception handler for label: ' + pExceptionSpec.Lbl.TokenText,
                              fGrammar.GrammarFile,
                              pExceptionSpec.Lbl.TokenLine,
                              pExceptionSpec.Lbl.TokenColumn)
      else
         fGrammar.Tool.Error( 'Rule "' + fRuleName + '" already has an exception handler',
                              fGrammar.GrammarFile,
                              pExceptionSpec.Lbl.TokenLine,
                              pExceptionSpec.Lbl.TokenColumn)
   end
   else
      fExceptionSpecs.Add( pExceptionSpec);
*)
end;

// ============================================================================
// IsLexerAutoGenRule
// ============================================================================
function TRuleBlock.IsLexerAutoGenRule: boolean;
begin
   result := (fRuleName = 'nextToken');
end;

// ============================================================================
// SetOption
// ============================================================================
procedure TRuleBlock.SetOption(pKey, pValue: IToken);
var
   lg: ILexerGrammar;
   ts: ITokenSymbol;

begin
   // ---------------------------------------------------------------
   // Dummy if. Needed to help commenting ifs.
   // ---------------------------------------------------------------
   if false then

   // ---------------------------------------------------------------
   // Option: defaultErrorHandler
   // ---------------------------------------------------------------
   else if pKey.TokenText = 'defaultErrorHandler' then
   begin
      if pValue.TokenText = 'true' then
         fDefErrorHandler := true
      else if pValue.TokenText = 'false' then
         fDefErrorHandler := false
      else
         fGrammar.Tool.Error( 'Value for "defaultErrorHandler" must be true or false',
                              fGrammar.GrammarFile,
                              pKey.TokenLine,
                              pKey.TokenColumn)
   end

   // ---------------------------------------------------------------
   // Option: testLiterals
   // ---------------------------------------------------------------
   else if pKey.TokenText = 'testLiterals' then
   begin
      if pValue.TokenText = 'true' then
         fTestLiterals := true
      else if pValue.TokenText = 'false' then
         fTestLiterals := false
      else
         fGrammar.Tool.Error( 'Value for "testLiterals" must be true or false',
                              fGrammar.GrammarFile,
                              pKey.TokenLine,
                              pKey.TokenColumn)
   end

   // ---------------------------------------------------------------
   // Option: generateAmbigWarnings
   // ---------------------------------------------------------------
   else if pKey.TokenText = 'generateAmbigWarnings' then
   begin
      if pValue.TokenText = 'true' then
         fGenAmbigWarnings := true
      else if pValue.TokenText = 'false' then
         fGenAmbigWarnings := false
      else
         fGrammar.Tool.Error( 'Value for "generateAmbigWarnings" must be true or false',
                              fGrammar.GrammarFile,
                              pKey.TokenLine,
                              pKey.TokenColumn)
   end

   // ---------------------------------------------------------------
   // Option: ignore
   // ---------------------------------------------------------------
   else if pKey.TokenText = 'ignore' then
   begin
      if fGrammar.QueryInterface(ILexerGrammar, lg) <> S_OK then
         fGrammar.Tool.Error( '"Ignore" option only valid for lexer rules',
                              fGrammar.GrammarFile,
                              pKey.TokenLine,
                              pKey.TokenColumn)
      else
         fIgnoreRule := pValue.TokenText
   end

   // ---------------------------------------------------------------
   // Option: paraphrase
   // ---------------------------------------------------------------
   else if pKey.TokenText = 'paraphrase' then
   begin
      if fGrammar.QueryInterface(ILexerGrammar, lg) <> S_OK then
         fGrammar.Tool.Error( '"Paraphrase" option only valid for lexer rules',
                              fGrammar.GrammarFile,
                              pKey.TokenLine,
                              pKey.TokenColumn)
      else
      begin
         ts := fGrammar.TokenManager.TokenSymbol[fRuleName];

         if ts = nil then
            fGrammar.Tool.Panic('Cannot find token associated with rule ' + fRuleName)
         else
            ts.Paraphrase := pValue.TokenText
      end
   end

   // ---------------------------------------------------------------
   // Illegal option
   // ---------------------------------------------------------------
   else
      fGrammar.Tool.Error( Format( MSG_W_ILLEGALRULEOPTION, [pKey.TokenText]),
                           fGrammar.GrammarFile,
                           pKey.TokenLine,
                           pKey.TokenColumn);
end;


// ****************************************************************************
//                                                                    Internals
// ****************************************************************************
function TRuleBlock.GetOneOrMoreBlocks: TInterfaceList;
begin
   result := fOneOrMoreBlocks;
end;

function TRuleBlock.GetNMBlocks : TInterfaceList;
begin
   result := fNMBlocks;
end;


function TRuleBlock.GetSynPredBlocks: TInterfaceList;
begin
   result := fSynPredBlocks;
end;

function TRuleBlock.GetExHandlerCode: AnsiString;
begin
   result := fExHandlerCode;
end;

function TRuleBlock.GetExHandlerType: AnsiString;
begin
   result := fExHandlerType;
end;

procedure TRuleBlock.SetExHandlerCode(pExCode: AnsiString);
begin
   fExHandlerCode := pExCode;
end;

procedure TRuleBlock.SetExHandlerType(pExType: AnsiString);
begin
   fExHandlerType := pExType;
end;

end.