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,418 @@
+unit wpPar;
+
+interface
+uses
+   SysUtils,
+   Generics.Collections,
+   wpLex;
+
+type
+   TStringMap = TDictionary<AnsiString,AnsiString>;
+
+
+   TwpPar = class
+      private
+         fLex  : TwpLex;
+
+         fConstants  : TStringMap;
+         fTypes      : TStringMap;
+
+      protected
+         function    Match( ttype   : TTokenType;  dispose: boolean=true):TToken;   overload;
+         function    Match( ttypes  : TTokenTypes; dispose: boolean=true):TToken;   overload;
+
+      protected
+         procedure   block;
+         procedure   constant;
+         procedure   uconstant;
+         procedure   typedef;
+
+      public
+         procedure   prg;
+
+      public
+         constructor Create( Lexer: TwpLex);
+         destructor  Destroy; override;
+   end;
+
+   EwpPar = Exception;
+
+
+implementation
+
+{ TwpPar }
+
+
+
+// @@@: Construction / destruction ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+//
+//                                  Construction / destruction
+//
+// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+// ================================================================================================
+// Constructor
+// ================================================================================================
+constructor TwpPar.Create(Lexer: TwpLex);
+begin
+   inherited Create;
+
+   fLex        := Lexer;
+   fConstants  := TStringMap.Create;
+   fTypes      := TStringMap.Create;
+end;
+
+// ================================================================================================
+// Destructor
+// ================================================================================================
+destructor TwpPar.Destroy;
+begin
+   fConstants  .Free;
+   fTypes      .Free;
+
+   inherited
+end;
+
+
+
+// @@@: Internals +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+//
+//                                           Internals
+//
+// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+// ================================================================================================
+//
+// ================================================================================================
+function TwpPar.Match(ttype: TTokenType; dispose: boolean): TToken;
+var
+   t: TToken;
+
+begin
+   result := nil;
+   t      := fLex.NextToken;
+
+   if t.TokenType = ttype then
+      if dispose
+         then t.Free
+         else result := t
+
+   else
+      raise EwpPar.Create('Unexpected token')
+end;
+
+// ================================================================================================
+//
+// ================================================================================================
+function TwpPar.Match(ttypes: TTokenTypes; dispose: boolean): TToken;
+var
+   t: TToken;
+
+begin
+   result := nil;
+   t      := fLex.NextToken;
+
+   if t.TokenType in ttypes then
+      if dispose
+         then t.Free
+         else result := t
+   else
+      raise EwpPar.Create('Unexpected token')
+end;
+
+// @@@: Interface +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+//
+//                                           Interface
+//
+// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+// ================================================================================================
+// Program
+// ================================================================================================
+procedure TwpPar.prg;
+var
+   t  : TToken;
+
+begin
+   if Assigned( fLex) then
+   begin
+      Match(LT_PROGRAM);
+      Match(TT_ID);
+      Match(TT_LPAREN);
+
+      t := fLex.NextToken;
+
+      // id [, id]*
+      if t.TokenType = TT_ID then
+      begin
+         t.Free;
+         t := fLex.NextToken;
+
+         while t.TokenType = TT_COMMA do
+         begin
+            t.Free;
+            Match(TT_ID);
+            t := fLex.NextToken;
+         end;
+      end;
+
+      if t.TokenType <> TT_RPAREN then
+         raise EwpPar.Create('")" expected');
+
+      Match(TT_SEMI);
+      block;
+      Match(TT_DOT)
+   end;
+end;
+
+
+// ================================================================================================
+// block
+// ================================================================================================
+procedure TwpPar.block;
+var
+   token : TToken;
+   ttype : TTokenType;
+   start : TTokenTypes;
+   start2: TTokenTypes;
+
+begin
+   start := [LT_LABEL,LT_CONST,LT_TYPE,LT_VAR,LT_PROCEDURE,LT_FUNCTION,LT_BEGIN];
+   start2:= [LT_LABEL,LT_CONST,LT_TYPE,LT_VAR,LT_PROCEDURE,LT_FUNCTION];
+   token := fLex.NextToken;
+
+   if token.TokenType in start then
+   begin
+      while token.TokenType in start2 do
+      begin
+         case token.TokenType of
+            // ------------------------------------------------------
+            // Label
+            // ------------------------------------------------------
+            LT_LABEL:
+               while true do
+               begin
+                  Match( TT_UINT);
+
+                  token := fLex.NextToken;
+                  ttype := token.TokenType;
+
+                  token.Free;
+
+                  case ttype of
+                     TT_COMMA : ;
+                     TT_SEMI  : begin token := fLex.NextToken; break end;
+                     else raise EwpPar.Create('Expected: ,;');
+                  end;
+               end;
+
+            // ------------------------------------------------------
+            // Const
+            // ------------------------------------------------------
+            LT_CONST:
+               begin
+                  token := fLex.NextToken;
+                  ttype := token.TokenType;
+
+                  while ttype = TT_ID do
+                  begin
+                     token.Free;
+                     Match(TT_EQ);
+                     constant;
+                     Match(TT_SEMI);
+
+                     token := flex.NextToken;
+                     ttype := token.TokenType;
+                  end;
+               end;
+
+            // ------------------------------------------------------
+            // Type
+            // ------------------------------------------------------
+            LT_TYPE:
+               begin
+                  token := fLex.NextToken;
+                  ttype := token.TokenType;
+
+                  while ttype = TT_ID do
+                  begin
+                     token.Free;
+                     Match(TT_EQ);
+                     typedef;
+                     Match(TT_SEMI);
+
+                     token := flex.NextToken;
+                     ttype := token.TokenType;
+                  end;
+               end;
+
+            LT_VAR:
+               begin
+
+               end;
+
+            LT_PROCEDURE:
+               begin
+
+               end;
+
+            LT_FUNCTION:
+               begin
+
+               end;
+         end;
+
+//         token := fLex.NextToken
+      end;
+
+      if token.TokenType = LT_BEGIN then
+      begin
+
+         Match(LT_END)
+      end
+
+      else
+         raise EwpPar.Create('Expected: Begin');
+   end
+
+   else
+      raise EwpPar.Create('Expected: label, const, type, var, procedure, function, begin');
+end;
+
+
+// ================================================================================================
+// Constant
+// ================================================================================================
+procedure TwpPar.constant;
+var
+   token: TToken;
+   ttype: TTokenType;
+
+begin
+   token := fLex.NextToken;
+   ttype := token.TokenType;
+
+   if ttype in [TT_PLUS,TT_MINUS,TT_ID,TT_UINT,TT_UREAL] then
+   begin
+      if ttype in [TT_PLUS,TT_MINUS] then
+      begin
+         token.Free;
+
+         token := fLex.NextToken;
+         ttype := token.TokenType;
+      end;
+
+      token.Free;
+
+      case ttype of
+         TT_ID    : ;
+         TT_UINT  : ;
+         TT_UREAL : ;
+         else raise EwpPar.Create('Expected: id,int,real')
+      end
+   end
+
+   else if ttype in [TT_CHAR, TT_STRING] then
+   begin
+      token.Free;
+   end
+
+   else
+      raise EwpPar.Create('Expected: +,-,id,int,real,string');
+end;
+
+// ================================================================================================
+// Unsigned constant
+// ================================================================================================
+procedure TwpPar.uconstant;
+var
+   token: TToken;
+   ttype: TTokenType;
+
+begin
+   token := fLex.NextToken;
+   ttype := token.TokenType;
+
+   token.Free;
+
+   case token.TokenType of
+      TT_ID    : ;
+      TT_UINT  : ;
+      TT_UREAL : ;
+      LT_NIL   : ;
+      TT_STRING: ;
+      else raise EwpPar.Create('Expected: id,int,real,nil,string')
+   end;
+end;
+
+// ================================================================================================
+// Type
+// ================================================================================================
+procedure TwpPar.typedef;
+var
+   token: TToken;
+   ttype: TTokenType;
+   ttext: AnsiString;
+
+   f_const  : TTokenTypes;
+
+begin
+   token := fLex.NextToken;
+   ttype := token.TokenType;
+   ttext := token.TokenText;
+
+   token.Free;
+
+   // ---------------------------------------------------------------
+   // TT_ID
+   //
+   // Identifier can be an existing type identifier, or an existing
+   // constant identifier. If it is contant identifier, then it must
+   // be a range specification.
+   // ---------------------------------------------------------------
+   if ttype = TT_ID then
+   begin
+      // --------------------------------------------------
+      // constant .. constant
+      // --------------------------------------------------
+      if fConstants.ContainsKey(ttext) then
+      begin
+         Match(TT_RANGE);
+
+         token := fLex.NextToken;
+         ttype := token.TokenType;
+         ttext := token.TokenText;
+
+         token.Free;
+      end
+
+      // --------------------------------------------------
+      // type identifier
+      // --------------------------------------------------
+      else if fTypes.ContainsKey(ttext) then
+      begin
+
+      end
+
+      // --------------------------------------------------
+      // Not an constant or type identifier
+      // --------------------------------------------------
+      else
+         EwpPar.Create('Expected a type or constant identifier' );
+   end;
+
+
+end;
+
+
+
+end.