Initial check in docu

2026-01-03 18:31:15 +01:00
parent e2c3cbc520
commit ee130973e2
98 changed files with 9430 additions and 0 deletions
@@ -0,0 +1,36 @@
+program calc;
+
+{$APPTYPE CONSOLE}
+
+uses
+   Classes,
+   SysUtils,
+   calcLexer  in 'calcLexer.pas',
+   calcParser in 'calcParser.pas';
+
+var
+   stm:  TFileStream;
+   lex:  TcalcLexer;
+   par:  TcalcParser;
+
+begin
+   if ParamCount <> 1 then
+   begin
+      writeln('usage: calc <filename>');
+      exit;
+   end
+   else
+   begin
+      try
+         stm := TFileStream.Create( ParamStr(1), fmOpenRead);
+         lex := TcalcLexer.Create(stm);
+         par := TcalcParser.Create(lex);
+
+         par.calc;
+      except
+      end;
+   end;
+
+   stm.Free;
+   par.Free;
+end.
@@ -0,0 +1,5 @@
+1+2+3+4+5+6+7+8+9;
+(((((2+3)))));
+(-1*(-2*(-3*(-4+ -5))));
+(-1*(-2*(-3*(-4+  5))));
+7 * -(-9);
@@ -0,0 +1,49 @@
+// ============================================================================
+// Demo lexer for four operator calculator
+// ============================================================================
+unit calcLexer;
+
+lexer TcalcLexer;
+options
+{
+   exportVocab = calcLexer;
+}
+
+// ============================================================================
+// Simple tokens
+// ============================================================================
+LPAREN   : '(';
+RPAREN   : ')';
+
+PLUS     : '+';
+MINUS    : '-';
+STAR     : '*';
+SLASH    : '/';
+
+SEMI     : ';';
+
+// ============================================================================
+// INT
+// ============================================================================
+INT      : ('0'..'9')+;
+
+// ============================================================================
+// White space
+// ============================================================================
+WS
+   : 
+   (  
+      options 
+      {
+         generateAmbigWarnings = false;
+      }
+      :  '\r' '\n'      { newLine;  }
+      |  '\r'           { newLine;  }
+      |  '\n'           { newLine;  }
+      |  '\t'           { tab;      }
+      |  ' '
+   )
+   {
+      _ttype := TT_SKIP;
+   }
+   ;
@@ -0,0 +1,430 @@
+// ============================================================================
+// This file is generated by the Delphi Parser Generator.
+// ----------------------------------------------------------------------------
+// DPG version: 1.0.1.0d
+// Grammar:     calcLexer
+// ============================================================================
+unit calcLexer;
+
+interface
+
+uses
+   calcLexerTokens,
+   Classes,
+   Contnrs,
+   dpgLexer,
+   dpgToken,
+   dpgTypes,
+   SysUtils;
+
+type
+   // =========================================================================
+   // Class TcalcLexer declaration
+   // =========================================================================
+   TcalcLexer = class( TdpgLexer)
+   
+   protected // Public grammar rules ("rescoped")
+      procedure mLPAREN ( pCreate: boolean);
+      procedure mRPAREN ( pCreate: boolean);
+      procedure mPLUS   ( pCreate: boolean);
+      procedure mMINUS  ( pCreate: boolean);
+      procedure mSTAR   ( pCreate: boolean);
+      procedure mSLASH  ( pCreate: boolean);
+      procedure mSEMI   ( pCreate: boolean);
+      procedure mINT    ( pCreate: boolean);
+      procedure mWS     ( pCreate: boolean);
+   
+   public
+      function  NextToken: IdpgToken; override;
+   end;
+
+implementation
+uses
+   dpgException,
+   dpgExceptionSemantic,
+   dpgExceptionMismatchedChar;
+
+// ============================================================================
+// mLPAREN
+// ============================================================================
+procedure TcalcLexer.mLPAREN( pCreate: boolean);
+var
+   _begin: integer;
+   _save: integer;
+   _token: IdpgToken;
+   _ttype: integer;
+
+begin
+   _begin   := Length( fText) +1;
+   _token   := nil;
+   _ttype   := TT_LPAREN;
+   
+   match('(');
+   
+   if (_ttype <> TT_SKIP) and (pCreate = true) then
+   begin
+      _token            := makeToken( _ttype);
+      _token.TokenText  := Copy( fText, _begin, Length(fText)-_begin+1);
+   end;
+   
+   fReturnToken := _token;
+end;
+
+// ============================================================================
+// mRPAREN
+// ============================================================================
+procedure TcalcLexer.mRPAREN( pCreate: boolean);
+var
+   _begin: integer;
+   _save: integer;
+   _token: IdpgToken;
+   _ttype: integer;
+
+begin
+   _begin   := Length( fText) +1;
+   _token   := nil;
+   _ttype   := TT_RPAREN;
+   
+   match(')');
+   
+   if (_ttype <> TT_SKIP) and (pCreate = true) then
+   begin
+      _token            := makeToken( _ttype);
+      _token.TokenText  := Copy( fText, _begin, Length(fText)-_begin+1);
+   end;
+   
+   fReturnToken := _token;
+end;
+
+// ============================================================================
+// mPLUS
+// ============================================================================
+procedure TcalcLexer.mPLUS( pCreate: boolean);
+var
+   _begin: integer;
+   _save: integer;
+   _token: IdpgToken;
+   _ttype: integer;
+
+begin
+   _begin   := Length( fText) +1;
+   _token   := nil;
+   _ttype   := TT_PLUS;
+   
+   match('+');
+   
+   if (_ttype <> TT_SKIP) and (pCreate = true) then
+   begin
+      _token            := makeToken( _ttype);
+      _token.TokenText  := Copy( fText, _begin, Length(fText)-_begin+1);
+   end;
+   
+   fReturnToken := _token;
+end;
+
+// ============================================================================
+// mMINUS
+// ============================================================================
+procedure TcalcLexer.mMINUS( pCreate: boolean);
+var
+   _begin: integer;
+   _save: integer;
+   _token: IdpgToken;
+   _ttype: integer;
+
+begin
+   _begin   := Length( fText) +1;
+   _token   := nil;
+   _ttype   := TT_MINUS;
+   
+   match('-');
+   
+   if (_ttype <> TT_SKIP) and (pCreate = true) then
+   begin
+      _token            := makeToken( _ttype);
+      _token.TokenText  := Copy( fText, _begin, Length(fText)-_begin+1);
+   end;
+   
+   fReturnToken := _token;
+end;
+
+// ============================================================================
+// mSTAR
+// ============================================================================
+procedure TcalcLexer.mSTAR( pCreate: boolean);
+var
+   _begin: integer;
+   _save: integer;
+   _token: IdpgToken;
+   _ttype: integer;
+
+begin
+   _begin   := Length( fText) +1;
+   _token   := nil;
+   _ttype   := TT_STAR;
+   
+   match('*');
+   
+   if (_ttype <> TT_SKIP) and (pCreate = true) then
+   begin
+      _token            := makeToken( _ttype);
+      _token.TokenText  := Copy( fText, _begin, Length(fText)-_begin+1);
+   end;
+   
+   fReturnToken := _token;
+end;
+
+// ============================================================================
+// mSLASH
+// ============================================================================
+procedure TcalcLexer.mSLASH( pCreate: boolean);
+var
+   _begin: integer;
+   _save: integer;
+   _token: IdpgToken;
+   _ttype: integer;
+
+begin
+   _begin   := Length( fText) +1;
+   _token   := nil;
+   _ttype   := TT_SLASH;
+   
+   match('/');
+   
+   if (_ttype <> TT_SKIP) and (pCreate = true) then
+   begin
+      _token            := makeToken( _ttype);
+      _token.TokenText  := Copy( fText, _begin, Length(fText)-_begin+1);
+   end;
+   
+   fReturnToken := _token;
+end;
+
+// ============================================================================
+// mSEMI
+// ============================================================================
+procedure TcalcLexer.mSEMI( pCreate: boolean);
+var
+   _begin: integer;
+   _save: integer;
+   _token: IdpgToken;
+   _ttype: integer;
+
+begin
+   _begin   := Length( fText) +1;
+   _token   := nil;
+   _ttype   := TT_SEMI;
+   
+   match(';');
+   
+   if (_ttype <> TT_SKIP) and (pCreate = true) then
+   begin
+      _token            := makeToken( _ttype);
+      _token.TokenText  := Copy( fText, _begin, Length(fText)-_begin+1);
+   end;
+   
+   fReturnToken := _token;
+end;
+
+// ============================================================================
+// mINT
+// ============================================================================
+procedure TcalcLexer.mINT( pCreate: boolean);
+var
+   _begin: integer;
+   _cnt_10: integer;
+   _save: integer;
+   _token: IdpgToken;
+   _ttype: integer;
+
+begin
+   _begin   := Length( fText) +1;
+   _token   := nil;
+   _ttype   := TT_INT;
+   
+   _cnt_10 := 0;
+   
+   while(true) do
+   begin
+      if (( LA(1) in ['0'..'9'])) then
+      begin
+         match( ['0'..'9']);
+      end
+      
+      else
+      begin
+         if _cnt_10 >= 1 then
+            break
+         else
+            Raise EdpgMismatchedChar.Create( LA(1), ['0'..'9'], FileName, Line, Column);
+      end;
+      
+      INC(_cnt_10);
+   end;
+   
+   if (_ttype <> TT_SKIP) and (pCreate = true) then
+   begin
+      _token            := makeToken( _ttype);
+      _token.TokenText  := Copy( fText, _begin, Length(fText)-_begin+1);
+   end;
+   
+   fReturnToken := _token;
+end;
+
+// ============================================================================
+// mWS
+// ============================================================================
+procedure TcalcLexer.mWS( pCreate: boolean);
+var
+   _begin: integer;
+   _save: integer;
+   _token: IdpgToken;
+   _ttype: integer;
+
+begin
+   _begin   := Length( fText) +1;
+   _token   := nil;
+   _ttype   := TT_WS;
+   
+   if (( LA(1) in [#13])) then
+   begin
+      match(#13);
+      match(#10);
+      newLine;
+   end
+   
+   else if (( LA(1) in [#13])) then
+   begin
+      match(#13);
+      newLine;
+   end
+   
+   else if (( LA(1) in [#10])) then
+   begin
+      match(#10);
+      newLine;
+   end
+   
+   else if (( LA(1) in [#9])) then
+   begin
+      match(#9);
+      tab;
+   end
+   
+   else if (( LA(1) in [' '])) then
+   begin
+      match(' ');
+   end
+   
+   else
+      Raise EdpgMismatchedChar.Create( LA(1), [#9..#10,#13,' '], FileName, Line, Column);
+   _ttype := TT_SKIP;
+   
+   if (_ttype <> TT_SKIP) and (pCreate = true) then
+   begin
+      _token            := makeToken( _ttype);
+      _token.TokenText  := Copy( fText, _begin, Length(fText)-_begin+1);
+   end;
+   
+   fReturnToken := _token;
+end;
+
+// ----------------------------------------------------------------------------
+// NextToken
+// ----------------------------------------------------------------------------
+function TcalcLexer.NextToken : IdpgToken;
+var
+   _first   : TdpgCharSet;
+
+begin
+   _first := [#9..#10,#13,' ','('..'+','-','/'..'9',';'];
+   
+   while( true) do
+   begin
+      ResetText;
+      
+      try
+         if (( LA(1) in ['('])) then
+         begin
+            mLPAREN(true);
+            result := fReturnToken;
+         end
+         
+         else if (( LA(1) in [')'])) then
+         begin
+            mRPAREN(true);
+            result := fReturnToken;
+         end
+         
+         else if (( LA(1) in ['+'])) then
+         begin
+            mPLUS(true);
+            result := fReturnToken;
+         end
+         
+         else if (( LA(1) in ['-'])) then
+         begin
+            mMINUS(true);
+            result := fReturnToken;
+         end
+         
+         else if (( LA(1) in ['*'])) then
+         begin
+            mSTAR(true);
+            result := fReturnToken;
+         end
+         
+         else if (( LA(1) in ['/'])) then
+         begin
+            mSLASH(true);
+            result := fReturnToken;
+         end
+         
+         else if (( LA(1) in [';'])) then
+         begin
+            mSEMI(true);
+            result := fReturnToken;
+         end
+         
+         else if (( LA(1) in ['0'..'9'])) then
+         begin
+            mINT(true);
+            result := fReturnToken;
+         end
+         
+         else if (( LA(1) in [#9..#10,#13,' '])) then
+         begin
+            mWS(true);
+            result := fReturnToken;
+         end
+         
+         else
+         begin
+            if LA(1) = EOF_CHAR then
+            begin
+               uponEof;
+               result := TdpgToken.Create(TT_EOF);
+            end
+            
+            else
+               Raise EdpgMismatchedChar.Create(LA(1), _first, FileName, Line, Column);
+         end;
+         
+         // --------------------------------------------------------------
+         // If we found a SKIP token, then try again...
+         // --------------------------------------------------------------
+         if result = nil then
+            continue;
+            
+         // --------------------------------------------------------------
+         // Now we have a valid token, so exit the function
+         // --------------------------------------------------------------
+         break;
+         
+      except
+         Raise;
+      end;
+   end;
+end;
+
+end.
@@ -0,0 +1,24 @@
+// ============================================================================
+// This file is generated by the Delphi Parser Generator.
+// ----------------------------------------------------------------------------
+// DPG version: 1.0.1.0d
+// Grammar:     calcLexer
+// ============================================================================
+unit calcLexerTokens;
+
+interface
+
+const
+   TT_EOF    = 1;
+   TT_LPAREN = 4;
+   TT_RPAREN = 5;
+   TT_PLUS   = 6;
+   TT_MINUS  = 7;
+   TT_STAR   = 8;
+   TT_SLASH  = 9;
+   TT_SEMI   = 10;
+   TT_INT    = 11;
+   TT_WS     = 12;
+
+implementation
+end.
@@ -0,0 +1,12 @@
+// $Delphi Parser Generator: calcLexer -> calcLexerTokens.txt$
+TcalcLexer
+TT_EOF=1
+TT_LPAREN=4
+TT_RPAREN=5
+TT_PLUS=6
+TT_MINUS=7
+TT_STAR=8
+TT_SLASH=9
+TT_SEMI=10
+TT_INT=11
+TT_WS=12
@@ -0,0 +1,93 @@
+// ============================================================================
+// Demo parser for four operator calculator
+// ============================================================================
+unit calcParser;
+
+parser TcalcParser;
+options
+{
+   importVocab = calcLexer;
+   exportVocab = calcParser;
+//   k = 2;
+}
+
+// ============================================================================
+// calc
+// ============================================================================
+calc
+local
+{
+   v: integer;
+}
+   :  (v=expression SEMI {writeln(v);} )+
+   ;
+
+
+// ============================================================================
+// expression
+// ============================================================================
+expression returns [integer]
+   : result=simpleExpression
+   ;
+
+// ============================================================================
+// simpleExpression
+// ============================================================================
+simpleExpression returns [integer]
+local
+{
+   v  : integer;
+}
+   :  result=term
+      (
+         PLUS  v=term   {  result := result + v;   }
+      |  MINUS v=term   {  result := result - v;   }
+      )*
+   ;
+
+// ============================================================================
+// term
+// ============================================================================
+term returns [integer]
+local
+{
+   v  : integer;
+}
+   :  result=factor 
+      (
+         STAR  v=factor {  result := result *   v;   }
+      |  SLASH v=factor {  result := result div v;   }
+      )*
+   ;
+
+// ============================================================================
+// factor
+// ============================================================================
+factor returns [integer]
+local
+{
+   s: integer;
+}
+{
+   s := 1;
+}
+   :  
+      (
+         PLUS  { s :=  1; }
+      |  MINUS { s := -1; }
+      )?
+      (
+         result=uInt
+      |  LPAREN result=expression RPAREN
+      )
+      {
+         result := s * result;
+      }
+   ;
+      
+// ============================================================================
+// uInt
+// ============================================================================
+uInt returns [integer]
+   :  x:INT { result := StrToInt( x.TokenText); }
+   ;
@@ -0,0 +1,203 @@
+// ============================================================================
+// This file is generated by the Delphi Parser Generator.
+// ----------------------------------------------------------------------------
+// DPG version: 1.0.1.0d
+// Grammar:     calcParser
+// ============================================================================
+unit calcParser;
+
+interface
+
+uses
+   calcParserTokens,
+   Classes,
+   Contnrs,
+   dpgLLkParser,
+   dpgToken,
+   dpgTypes,
+   SysUtils;
+
+type
+   // =========================================================================
+   // Class TcalcParser declaration
+   // =========================================================================
+   TcalcParser = class( TdpgLLkParser)
+   
+   public    // Public grammar rules
+      procedure calc             ;
+      procedure expression       ;
+      procedure simpleExpression ;
+      procedure term             ;
+      procedure factor           ;
+      procedure uInt             ;
+   
+   end;
+
+implementation
+uses
+   dpgException,
+   dpgExceptionSemantic,
+   dpgExceptionMismatchedToken;
+
+// ============================================================================
+// calc
+// ============================================================================
+procedure TcalcParser.calc;
+var
+   _cnt_16: integer;
+   v: integer;
+
+begin
+   
+   _cnt_16 := 0;
+   
+   while(true) do
+   begin
+      if (( LA(1) in [TT_LPAREN,TT_PLUS..TT_MINUS,TT_INT])) then
+      begin
+         expression;
+         match(TT_SEMI);
+         writeln(v);
+      end
+      
+      else
+      begin
+         if _cnt_16 >= 1 then
+            break
+         else
+            Raise EdpgMismatchedToken.Create( LT(1), [TT_LPAREN,TT_PLUS..TT_MINUS,TT_INT], FileName);
+      end;
+      
+      INC(_cnt_16);
+   end;
+end;
+
+// ============================================================================
+// expression
+// ============================================================================
+procedure TcalcParser.expression;
+begin
+   
+   simpleExpression;
+end;
+
+// ============================================================================
+// simpleExpression
+// ============================================================================
+procedure TcalcParser.simpleExpression;
+var
+   v  : integer;
+
+begin
+   
+   term;
+   
+   while(true) do
+   begin
+      if (( LA(1) in [TT_PLUS])) then
+      begin
+         match(TT_PLUS);
+         term;
+         result := result + v;
+      end
+      
+      else if (( LA(1) in [TT_MINUS])) then
+      begin
+         match(TT_MINUS);
+         term;
+         result := result - v;
+      end
+      
+      else
+         break;
+   end;
+   
+end;
+
+// ============================================================================
+// term
+// ============================================================================
+procedure TcalcParser.term;
+var
+   v  : integer;
+
+begin
+   
+   factor;
+   
+   while(true) do
+   begin
+      if (( LA(1) in [TT_STAR])) then
+      begin
+         match(TT_STAR);
+         factor;
+         result := result *   v;
+      end
+      
+      else if (( LA(1) in [TT_SLASH])) then
+      begin
+         match(TT_SLASH);
+         factor;
+         result := result div v;
+      end
+      
+      else
+         break;
+   end;
+   
+end;
+
+// ============================================================================
+// factor
+// ============================================================================
+procedure TcalcParser.factor;
+var
+   s: integer;
+
+begin
+   
+   s := 1;
+   
+   if (( LA(1) in [TT_PLUS])) then
+   begin
+      match(TT_PLUS);
+      s :=  1;
+   end
+   
+   else if (( LA(1) in [TT_MINUS])) then
+   begin
+      match(TT_MINUS);
+      s := -1;
+   end;
+   if (( LA(1) in [TT_INT])) then
+   begin
+      uInt;
+   end
+   
+   else if (( LA(1) in [TT_LPAREN])) then
+   begin
+      match(TT_LPAREN);
+      expression;
+      match(TT_RPAREN);
+   end
+   
+   else
+      Raise EdpgMismatchedToken.Create( LT(1), [TT_LPAREN,TT_INT], FileName);
+   result := s * result;
+end;
+
+// ============================================================================
+// uInt
+// ============================================================================
+procedure TcalcParser.uInt;
+var
+   x: IdpgToken;
+
+begin
+   
+   x := LT(1);
+   match(TT_INT);
+   result := StrToInt( x.TokenText);
+end;
+
+end.
@@ -0,0 +1,24 @@
+// ============================================================================
+// This file is generated by the Delphi Parser Generator.
+// ----------------------------------------------------------------------------
+// DPG version: 1.0.1.0d
+// Grammar:     calcParser
+// ============================================================================
+unit calcParserTokens;
+
+interface
+
+const
+   TT_EOF    = 1;
+   TT_LPAREN = 4;
+   TT_RPAREN = 5;
+   TT_PLUS   = 6;
+   TT_MINUS  = 7;
+   TT_STAR   = 8;
+   TT_SLASH  = 9;
+   TT_SEMI   = 10;
+   TT_INT    = 11;
+   TT_WS     = 12;
+
+implementation
+end.
@@ -0,0 +1,12 @@
+// $Delphi Parser Generator: calcParser -> calcParserTokens.txt$
+TcalcParser
+TT_EOF=1
+TT_LPAREN=4
+TT_RPAREN=5
+TT_PLUS=6
+TT_MINUS=7
+TT_STAR=8
+TT_SLASH=9
+TT_SEMI=10
+TT_INT=11
+TT_WS=12
@@ -0,0 +1,11 @@
+To build demo project you must first compile the grammars.
+This grammar CAN NOT! be compiled with the demo version of dpg.
+
+1. dpg calcLexer.g
+2. dpg calcParser.g
+
+After the compilation the project can be opened in delphi. Be sure that the dpg
+runtime library is in the delphi library path. (In the project settings, 
+or in the environment settings).
+
+Have fun...