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

unit dpglib.AlternativeBlock;

interface
uses
   System.Classes,
   dpgrtl.types,
   dpglib.types,
   dpglib.AlternativeElem;

type
   TAlternativeBlock = class( TAlternativeElem,
                              IAlternativeBlock,
                              IGrammarElem)
                                 
   // ---------------------------------------------------------------
   // Members
   // ---------------------------------------------------------------
   protected
      fAlternatives     : TInterfaceList;
      fInitAction       : AnsiString;
      fLabel            : AnsiString;

      fAltI             : integer;
      fAltJ             : integer;
      fAnalysisAlt      : integer;

      fHasAnAction      : boolean;
      fHasASynPred      : boolean;

      fID               : integer;
      fNot              : boolean;

      fGreedy           : boolean;  // (true)
      fGreedySet        : boolean;  // (false)

      fDoAutoGen        : boolean;  // (true)

      fWarnFollowAmbig  : boolean;  // (true)
      fGenAmbigWarnings : boolean;  // (true)

   // ---------------------------------------------------------------
   // Constructor/destructor
   // ---------------------------------------------------------------
   public
      constructor Create(  Grammar  : IGrammar);   overload;
      constructor Create(  Grammar  : IGrammar;
                           Start    : IToken;
                           Invert   : boolean);    overload;

   // ---------------------------------------------------------------
   // IGrammarElem overrides
   // ---------------------------------------------------------------
   public
      procedure   Generate;

      function    Look( K: integer) : ILookahead;
      function    AsString          : AnsiString;

   // ---------------------------------------------------------------
   // IAlternativeElem overrides
   // ---------------------------------------------------------------
   protected
      function    GetLabel      : AnsiString;
      procedure   SetLabel(  Lbl: AnsiString);

   // ---------------------------------------------------------------
   // IAlternativeBlock methods
   // ---------------------------------------------------------------
   protected
      function    GetID                        : integer;
      function    GetInitAction                : AnsiString;
      function    GetAutoGen                   : boolean;
      function    GetNot                       : boolean;
      function    GetHasASynPred               : boolean;
      function    GetHasAnAction               : boolean;
      function    GetWarnFollowAmbig           : boolean;
      function    GetGenAmbigWarnings          : boolean;
      function    GetGreedy                    : boolean;
      function    GetGreedySet                 : boolean;
      function    GetAlternatives              : TInterfaceList;
      function    GetAlternative( i: integer)  : IAlternative;
      function    GetAnalyzisAlt               : integer;
      function    GetAltI                      : integer;
      function    GetAltJ                      : integer;

      procedure   SetInitAction(       Action      : AnsiString);
      procedure   SetAutoGen(          AutoGen     : boolean);
      procedure   SetNot(              Invert      : boolean);
      procedure   SetHasASynPred(      SynPred     : boolean);
      procedure   SetHasAnAction(      Action      : boolean);
      procedure   SetWarnFollowAmbig(  Warn        : boolean);
      procedure   SetGenAmbigWarnings( Gen         : boolean);
      procedure   SetGreedy(           Greedy      : boolean);
      procedure   SetGreedySet(        GreedySet   : boolean);
      procedure   SetAlternatives(     Alts        : TInterfaceList);
      procedure   SetAnalyzisAlt(      Alt         : integer);
      procedure   SetAltI(             AltI        : integer);
      procedure   SetAltJ(             AltJ        : integer);

   public
      procedure   AddAlternative(   Alt: IAlternative);
      procedure   SetOption(  Key, Value: IToken);
      procedure   RemoveTracking(   Grammar: IGrammar);
      procedure   PrepareForAnalysis;  virtual;
   end;

implementation
uses
   System.SysUtils,
   dpglib.Messages;
   
var
   fNBlks : integer;

// ****************************************************************************
//                                                       Constructor/destructor
// ****************************************************************************
// ============================================================================
// Constructor
// ============================================================================
constructor TAlternativeBlock.Create(Grammar: IGrammar);
begin
   inherited Create( Grammar);

   fID               := fNblks +1;
   fNot              := false;

   fAlternatives     := TInterfaceList.Create;

   fHasAnAction      := false;
   fHasASynPred      := false;

   fGreedy           := true;
   fGreedySet        := false;
   fDoAutoGen        := true;

   fWarnFollowAmbig  := true;
   fGenAmbigWarnings := true;

   inc( fNblks);
end;

// ============================================================================
// Constructor
// ============================================================================
constructor TAlternativeBlock.Create(  Grammar : IGrammar;
                                       Start   : IToken;
                                       Invert  : boolean);
begin
   inherited Create( Grammar, Start);

   fID               := fNblks +1;
   fNot              := Invert;

   fAlternatives     := TInterfaceList.Create;

   fHasAnAction      := false;
   fHasASynPred      := false;

   fGreedy           := true;
   fGreedySet        := false;
   fDoAutoGen        := true;

   fWarnFollowAmbig  := true;
   fGenAmbigWarnings := true;

   inc( fNblks);
end;

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

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

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

// ****************************************************************************
//                                                IAlternativeElem overrides
// ****************************************************************************
// ============================================================================
// GetLabel
// ============================================================================
function TAlternativeBlock.GetLabel: AnsiString;
begin
   result := fLabel;
end;

// ============================================================================
// SetLabel
// ============================================================================
procedure TAlternativeBlock.SetLabel(Lbl: AnsiString);
begin
   fLabel := Lbl;
end;

// ****************************************************************************
//                                           IAlternativeBlock implementation
// ****************************************************************************
// ============================================================================
// GetID
// ============================================================================
function TAlternativeBlock.GetID: integer;
begin
   result := fID;
end;

// ============================================================================
// GetInitAction
// ============================================================================
function TAlternativeBlock.GetInitAction: AnsiString;
begin
   result := fInitAction;
end;

// ============================================================================
// GetAutoGen
// ============================================================================
function TAlternativeBlock.GetAutoGen: boolean;
begin
   result := fDoAutoGen;
end;

// ============================================================================
// GetNot
// ============================================================================
function TAlternativeBlock.GetNot: boolean;
begin
   result := fNot;
end;

// ============================================================================
// GetHasASynPred
// ============================================================================
function TAlternativeBlock.GetHasASynPred: boolean;
begin
   result := fHasASynPred;
end;

// ============================================================================
// GetGenAmbigWarnings
// ============================================================================
function TAlternativeBlock.GetGenAmbigWarnings: boolean;
begin
   result := fGenAmbigWarnings;
end;

// ============================================================================
// GetGreedy
// ============================================================================
function TAlternativeBlock.GetGreedy: boolean;
begin
   result := fGreedy;
end;

// ============================================================================
// GetGreedySet
// ============================================================================
function TAlternativeBlock.GetGreedySet: boolean;
begin
   result := fGreedySet;
end;

// ============================================================================
// GetHasAnAction
// ============================================================================
function TAlternativeBlock.GetHasAnAction: boolean;
begin
   result := fHasAnAction;
end;

// ============================================================================
// GetWarnFollowAmbig
// ============================================================================
function TAlternativeBlock.GetWarnFollowAmbig: boolean;
begin
   result := fWarnFollowAmbig;
end;

// ============================================================================
// GetAlternatives
// ============================================================================
function TAlternativeBlock.GetAlternatives: TInterfaceList;
begin
   result := fAlternatives;
end;

// ============================================================================
// GetAltI
// ============================================================================
function TAlternativeBlock.GetAltI: integer;
begin
   result := fAltI;
end;

// ============================================================================
// GetAltJ
// ============================================================================
function TAlternativeBlock.GetAltJ: integer;
begin
   result := fAltJ;
end;

// ============================================================================
// GetAnalyzisAlt
// ============================================================================
function TAlternativeBlock.GetAnalyzisAlt: integer;
begin
   result := fAnalysisAlt;
end;

// ============================================================================
// GetAlternative
// ============================================================================
function TAlternativeBlock.GetAlternative(i: integer): IAlternative;
begin
   if (i>=0) and (i<fAlternatives.Count) then
      fAlternatives.Items[i].QueryInterface(IAlternative, result);
end;

// ============================================================================
// SetInitAction
// ============================================================================
procedure TAlternativeBlock.SetInitAction(Action: AnsiString);
begin
   fInitAction := Action;
end;

// ============================================================================
// SetAlternatives
// ============================================================================
procedure TAlternativeBlock.SetAlternatives(Alts: TInterfaceList);
begin
   fAlternatives.Free;
   fAlternatives := Alts;
end;

// ============================================================================
// SetAutoGen
// ============================================================================
procedure TAlternativeBlock.SetAutoGen(AutoGen: boolean);
begin
   fDoAutoGen := AutoGen;
end;

// ============================================================================
// SetNot
// ============================================================================
procedure TAlternativeBlock.SetNot(Invert: boolean);
begin
   fNot := Invert;
end;

// ============================================================================
// SetHasASynPred
// ============================================================================
procedure TAlternativeBlock.SetHasASynPred(SynPred: boolean);
begin
   fHasASynPred := SynPred;
end;

// ============================================================================
// SetGenAmbigWarnings
// ============================================================================
procedure TAlternativeBlock.SetGenAmbigWarnings(Gen: boolean);
begin
   fGenAmbigWarnings := Gen;
end;

// ============================================================================
// SetGreedy
// ============================================================================
procedure TAlternativeBlock.SetGreedy(Greedy: boolean);
begin
   fGreedy := Greedy;
end;

// ============================================================================
// SetGreedySet
// ============================================================================
procedure TAlternativeBlock.SetGreedySet(GreedySet: boolean);
begin
   fGreedySet  := GreedySet;
end;

// ============================================================================
// SetHasAnAction
// ============================================================================
procedure TAlternativeBlock.SetHasAnAction(Action: boolean);
begin
   fHasAnAction := Action;
end;

// ============================================================================
// SetWarnFollowAmbig
// ============================================================================
procedure TAlternativeBlock.SetWarnFollowAmbig(Warn: boolean);
begin
   fWarnFollowAmbig := Warn;
end;

// ============================================================================
// SetAltI
// ============================================================================
procedure TAlternativeBlock.SetAltI(AltI: integer);
begin
   fAltI := AltI;
end;

// ============================================================================
// SetAltJ
// ============================================================================
procedure TAlternativeBlock.SetAltJ(AltJ: integer);
begin
   fAltJ := AltJ;
end;

// ============================================================================
// SetAnalyzisAlt
// ============================================================================
procedure TAlternativeBlock.SetAnalyzisAlt(Alt: integer);
begin
   fAnalysisAlt := Alt;
end;

// ============================================================================
// AddAlternative
// ============================================================================
procedure TAlternativeBlock.AddAlternative(Alt: IAlternative);
begin
   fAlternatives.Add( Alt);
end;

// ============================================================================
// SetOption
// ============================================================================
procedure TAlternativeBlock.SetOption(Key, Value: IToken);
begin
   // ---------------------------------------------------------------
   // Option: warnWhenFollowAmbig
   // ---------------------------------------------------------------
   if Key.TokenText = 'warnWhenFollowAmbig' then
   begin
      if Value.TokenText = 'true' then
         fWarnFollowAmbig := true
         
      else if Value.TokenText = 'false' then
         fWarnFollowAmbig := false
         
      else
         fGrammar.Tool.Error( 'Value for "warnWhenFollowAmbig" must be true or false',
                              fGrammar.GrammarFile,
                              Key.TokenLine,
                              Key.TokenColumn);
   end

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

   // ---------------------------------------------------------------
   // Option: greedy
   // ---------------------------------------------------------------
   else if Key.TokenText = 'greedy' then
   begin
      if Value.TokenText = 'true' then
      begin
         fGreedy     := true;
         fGreedySet  := true;
      end
      else if Value.TokenText = 'false' then
      begin
         fGreedy     := false;
         fGreedySet  := true;
      end
      else
         fGrammar.Tool.Error( 'Value for "greedy" must be true or false',
                              fGrammar.GrammarFile,
                              Key.TokenLine,
                              Key.TokenColumn);
   end

   // ---------------------------------------------------------------
   // Invalid option
   // ---------------------------------------------------------------
   else
   begin
      fGrammar.Tool.Error(    'Invalid subrule option: "' + Key.TokenText + '"',
                              fGrammar.GrammarFile,
                              Key.TokenLine,
                              Key.TokenColumn);
   end;
end;

// ============================================================================
// PrepareForAnalysis
// ============================================================================
procedure TAlternativeBlock.PrepareForAnalysis;
var
   i: integer;
   a: IAlternative;

begin
   for i:=0 to fAlternatives.Count -1 do
   begin
      // ------------------------------------------------------------
      // Deterministic() uses an alternative cache and sets lookahead
      // depth.
      // ------------------------------------------------------------
      if fAlternatives.Items[i].QueryInterface( IAlternative, a) = S_OK then
      begin
         a.CacheSize       := fGrammar.MaxK + 1;
         a.LookaheadDepth  := LOOKAHEAD_DEPTH_INIT;
      end;
   end;
end;

// ============================================================================
// RemoveTracking
//
// Walk the syntactic predicate and, for a rule ref R, remove the ref from the
// list of FOLLOW references for R (stored in the symbol table).
// ============================================================================
procedure TAlternativeBlock.RemoveTracking(Grammar: IGrammar);
var
   i     : integer;
   alt   : IAlternative;
   elem  : IAlternativeElem;
   ab    : IAlternativeBlock;
   rr    : IRuleRefElem;
   rs    : IRuleSymbol;

begin
   for i:=0 to fAlternatives.Count-1 do
   begin
      fAlternatives.Items[i].QueryInterface(IAlternative,alt);
      elem := alt.Head;

      while elem <> nil do
      begin
         // ---------------------------------------------------------
         // Handle RuleRef elements
         // ---------------------------------------------------------
         if elem.QueryInterface( IRuleRefElem, rr) = S_OK then
         begin
            Grammar.Symbol[rr.TargetRule].QueryInterface(IRuleSymbol,rs);

            if rs = nil then
            begin
//               pGrammar.Tool.Error( 'Rule "' + rr.TargetRule + '"' +
//                                    'referenced in (...)=>, but not defined.',

               Grammar.Tool.Error( Format( MSG_E_INVRULEINSYNPRED, [rr.TargetRule]),
                                    fGrammar.GrammarFile,
                                    0,0);
            end
            else
            begin
               rs.References.Remove( rr);
            end;
         end

         // ---------------------------------------------------------
         // Recurse into subrules
         // ---------------------------------------------------------
         else if elem.QueryInterface(IAlternativeBlock,ab) = S_OK then
         begin
            ab.RemoveTracking( Grammar);
         end;

         elem := elem.Next;
      end;
   end;
end;

initialization
   fNBlks := 0;

end.