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,626 @@
+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.