Initial check in lib

2026-01-03 18:33:48 +01:00
parent b20cd8e688
commit 5666f85e99
89 changed files with 36370 additions and 1 deletions
@@ -0,0 +1,610 @@
+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.