fdcil-cvs Mailing List for Free Pascal Compiler for IL

SourceForge Headquarters 1320 Columbia Street Suite 310 San Diego, CA 92101 +1 (858) 422-6466

Update of /cvsroot/fdcil/dev/miracle2k/fdcil-test
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv7003/miracle2k/fdcil-test

Modified Files:
	fdcil.Compiler.pas fdcil.ExceptionHandling.pas 
	fdcil.IO.Messages.Localize.pas fdcil.IO.Messages.pas 
	fdcil.Lexer.pas fdcil.Parser.pas fdcil.SymbolTable.pas 
	fdcil.Tokens.pas fdcil.bdsproj fdcil.dpr test.pas 
Log Message:
some updates

Index: fdcil.Compiler.pas
===================================================================
RCS file: /cvsroot/fdcil/dev/miracle2k/fdcil-test/fdcil.Compiler.pas,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** fdcil.Compiler.pas	15 Aug 2004 11:34:46 -0000	1.2
--- fdcil.Compiler.pas	16 Aug 2004 18:54:00 -0000	1.3
***************
*** 56,73 ****
  begin
    try
      SymbolTable := TSymbolTable.Create;
      SymbolTable.Init;
      Input := TFileInput.Create(FileName);
      Lexer := TLexer.Create(Input, SymbolTable);
!     Parser := TDelphiParser.Create(Lexer);
      Parser.Init;
!     Parser.&Program;
    except                       
      on E: FileNotFoundException do                                               
        MessageEmitter.Emit(mtFatal, System.String.Format(E_FILE_NOT_FOUND, FileName));
      on E: EFatalError do
!       MessageEmitter.Emit(mtFatal, E.Line, E.Column, E.Message);
      on E: EfdcilError do
!       MessageEmitter.Emit(mtError, E.Line, E.Column, E.Message);
    end;
  end;
--- 56,74 ----
  begin
    try
+     MessageEmitter.CurrFileName := System.IO.Path.GetFileName(FileName);
      SymbolTable := TSymbolTable.Create;
      SymbolTable.Init;
      Input := TFileInput.Create(FileName);
      Lexer := TLexer.Create(Input, SymbolTable);
!     Parser := TDelphiParser.Create(Lexer, SymbolTable);
      Parser.Init;
!     Parser.DoParse;
    except                       
      on E: FileNotFoundException do                                               
        MessageEmitter.Emit(mtFatal, System.String.Format(E_FILE_NOT_FOUND, FileName));
      on E: EFatalError do
!       MessageEmitter.Emit(mtFatal, E);
      on E: EfdcilError do
!       MessageEmitter.Emit(mtError, E);
    end;
  end;

Index: fdcil.Parser.pas
===================================================================
RCS file: /cvsroot/fdcil/dev/miracle2k/fdcil-test/fdcil.Parser.pas,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** fdcil.Parser.pas	15 Aug 2004 11:34:46 -0000	1.2
--- fdcil.Parser.pas	16 Aug 2004 18:54:00 -0000	1.3
***************
*** 23,27 ****

  interface
! 
  uses
    fdcil.ExceptionHandling,
--- 23,27 ----

  interface
!  
  uses
    fdcil.ExceptionHandling,
***************
*** 29,33 ****
    fdcil.IO.Messages.Localize,
    fdcil.Tokens,
!   fdcil.Lexer;

  type
--- 29,34 ----
    fdcil.IO.Messages.Localize,
    fdcil.Tokens,
!   fdcil.Lexer,
!   fdcil.SymbolTable;

  type
***************
*** 35,64 ****
    private
      fLexer: TLexer;
    protected
      function TokenToString(Token: TToken): string; overload;
      function TokenToString(TokenID: Integer): string; overload;
      function TokensToString(TokenIDs: array of Integer): string;

      procedure RaiseException(E: EfdcilError);
      procedure HandleException(E: Exception);

!     procedure Match(Token: Integer);
!     procedure SyncToken(StopTokens: TTokenSet);
      procedure Next;

      procedure &Interface;
      procedure &Implementation;
!     procedure Block;
      procedure Ident;
    public
!     function get_CurrentToken: Integer;
    public
!     constructor Create(Lexer: TLexer);

!     procedure &Program;
      procedure Init;

!     property Look: Integer read get_CurrentToken;
!     // TODO: add a shortcut property for fLexer.CurrToken
    end;

--- 36,91 ----
    private
      fLexer: TLexer;
+     fSymbolTable: TSymbolTable;
    protected
+     // TODO: Implement a ToString() method for TToken?
      function TokenToString(Token: TToken): string; overload;
      function TokenToString(TokenID: Integer): string; overload;
      function TokensToString(TokenIDs: array of Integer): string;

+     // Initializes the basic exception object with the current data from the
+     // Lexer, e.g. the current line; use this instead of the raise keyword.
      procedure RaiseException(E: EfdcilError);
+     procedure UnexpectedToken(Expected: string);
+     // Call within an except block; will analyze the current exception and
+     // write appropriate messages to the output.
      procedure HandleException(E: Exception);

!     // Directly proceed to next token
      procedure Next;
+     // Check if the current token equals the one that is expected; Proceeds
+     // to next token if successfull, otherwise an exception is raised.
+     procedure Match(TokenID: Integer);
+     // Used for error recovery; Calls Next(); until a token from "StopTokens"
+     // is found; Various token sets are defined in fdcil.ExceptionHandling.
+     procedure SyncToken(StopTokens: TTokenSet);

+     // Parsing Methods
+     procedure &Program;
+     procedure &Unit;
      procedure &Interface;
      procedure &Implementation;
!     procedure &Uses;
!     procedure &Type;
!     procedure TypeIdent;
!     procedure &Class;
!     procedure &Record;
!     procedure &Var;
!     procedure &Const;
!     procedure &ResourceString;
!     procedure Block(EndWithDot: boolean = False);
      procedure Ident;
    public
!     function get_CurrentTokenID: Integer;
!     function get_LookToken: TToken;
    public
!     constructor Create(Lexer: TLexer; SymbolTable: TSymbolTable);

!     procedure DoParse;
      procedure Init;

!     // TODO: Perhaps speed can be increased if you directly access a simple
!     // field member, without using any get-method
!     property Look: Integer read get_CurrentTokenID;
!     property LookToken: TToken read get_LookToken;
    end;

***************
*** 67,74 ****
  { TDelphiParser }

! constructor TDelphiParser.Create(Lexer: TLexer);
  begin
    inherited Create;
    fLexer := Lexer;
  end;

--- 94,102 ----
  { TDelphiParser }

! constructor TDelphiParser.Create(Lexer: TLexer; SymbolTable: TSymbolTable);
  begin
    inherited Create;
    fLexer := Lexer;
+   fSymbolTable := SymbolTable;
  end;

***************
*** 78,87 ****
  end;

! procedure TDelphiParser.Match(Token: Integer);
  begin
!   if fLexer.CurrToken.TokenID = Token then
      Next
    else
!     RaiseException(EExpectedError.Create(TokenToString(Token), TokenToString(fLexer.CurrToken)));
  end;

--- 106,115 ----
  end;

! procedure TDelphiParser.Match(TokenID: Integer);
  begin
!   if LookToken.TokenID = TokenID then
      Next
    else
!     UnexpectedToken(TokenToString(TokenID));
  end;

***************
*** 91,99 ****
  end;

! function TDelphiParser.get_CurrentToken: Integer;
  begin
    Result := fLexer.CurrToken.TokenID;
  end;

  procedure TDelphiParser.SyncToken(StopTokens: TTokenSet);

--- 119,132 ----
  end;

! function TDelphiParser.get_CurrentTokenID: Integer;
  begin
    Result := fLexer.CurrToken.TokenID;
  end;

+ function TDelphiParser.get_LookToken: TToken;
+ begin
+   Result := fLexer.CurrToken;
+ end;
+ 
  procedure TDelphiParser.SyncToken(StopTokens: TTokenSet);

***************
*** 117,125 ****
  procedure TDelphiParser.RaiseException(E: EfdcilError);
  begin
!   E.Line := fLexer.CurrToken.Line;
!   E.Column := fLexer.CurrToken.Column;
    raise E;
  end;

  procedure TDelphiParser.HandleException(E: Exception);
  begin
--- 150,163 ----
  procedure TDelphiParser.RaiseException(E: EfdcilError);
  begin
!   E.Line := LookToken.Line;
!   E.Column := LookToken.Column;
    raise E;
  end;

+ procedure TDelphiParser.UnexpectedToken(Expected: string);
+ begin
+   RaiseException(EExpectedError.Create(Expected, TokenToString(LookToken)));
+ end;
+ 
  procedure TDelphiParser.HandleException(E: Exception);
  begin
***************
*** 129,138 ****
    except
      on E: EParserError do
!       MessageEmitter.Emit(mtError, E.Line, E.Column, E.Message);
      on E: EExpectedError do
!       MessageEmitter.Emit(mtError, E.Line, E.Column, E.Message);
      on E: EFatalError do
      begin
!       MessageEmitter.Emit(mtFatal, E.Line, E.Column, E.Message);
        raise;  // Stop parsing when a fatal error occurs
      end;
--- 167,176 ----
    except
      on E: EParserError do
!       MessageEmitter.Emit(mtError, E);
      on E: EExpectedError do
!       MessageEmitter.Emit(mtError, E);
      on E: EFatalError do
      begin
!       MessageEmitter.Emit(mtFatal, E);
        raise;  // Stop parsing when a fatal error occurs
      end;
***************
*** 143,147 ****
  begin
    if Token.TokenID = T_IDENT then
!     Result := S_IDENTIFIER + ' ''' + Token.Value + '''' 
    else
      Result := TokenToString(Token.TokenID);
--- 181,185 ----
  begin
    if Token.TokenID = T_IDENT then
!     Result := S_IDENTIFIER_PREFIX + ' ''' + Token.Value + ''''
    else
      Result := TokenToString(Token.TokenID);
***************
*** 150,160 ****
  function TDelphiParser.TokenToString(TokenID: Integer): string;
  begin
-   // TODO: Lookup token string name in keyword table
    if TokenID = 0 then
      Result := S_END_OF_FILE
    else if TokenID = T_IDENT then   
      Result := S_IDENTIFIER
    else
!     Result := '''' + TokenID.ToString() + '''';
  end;

--- 188,201 ----
  function TDelphiParser.TokenToString(TokenID: Integer): string;
  begin
    if TokenID = 0 then
      Result := S_END_OF_FILE
    else if TokenID = T_IDENT then   
      Result := S_IDENTIFIER
+   else if TokenID = T_INT then
+     Result := S_NUMBER
+   else if TokenID = T_FLOAT then
+     Result := S_FLOAT
    else
!     Result := '''' + fSymbolTable.KeywordToString(TokenID) + '''';
  end;

***************
*** 168,259 ****
  end;

! // TODO: add a few explaining comments to the parsing procedures

  procedure TDelphiParser.&Program;
  begin
!   if Look = T_PROGRAM then
!   begin
!     Match(T_PROGRAM); Ident; Match(T_SEMICOLON);
!     &Implementation;
!     Block;
!   end
! 
!   else if Look = T_UNIT then
!   begin
!     Match(T_UNIT); Ident; Match(T_SEMICOLON);
!     Match(T_INTERFACE);
!     &Interface;
!     Match(T_IMPLEMENTATION);
!     &Implementation;
!     if Look = T_INITIALIZATION then begin
!       Match(T_INITIALIZATION);
!       Block;
!       Match(T_FINALIZATION);
!       Block;
!     end
!     // TODO: unit begin block
!     else if Look = T_FINALIZATION then
!       RaiseException(EParserError.Create(E_FIN_WITHOUT_INIT));
!     Match(T_END); Match(T_DOT);
!   end

!   else if Look = T_PACKAGE then
!     RaiseException(EFatalError.Create('Packages not yet supported'))

!   else if Look = T_LIBRARY then
!     RaiseException(EFatalError.Create('Libraries not yet supported'))
!                                                          
!   else
!     // TODO: "Root keyword" should be replaced by the token we would automatically
!     // expect after reading the file extension, e.g. "UNIT" for .pas files.
!     RaiseException(EExpectedError.Create('Root keyword', TokenToString(fLexer.CurrToken)));

!   if Look <> T_NULL then
!     MessageEmitter.Emit(mtHint, E_TEXT_AFTER_END_IGNORED);
  end;

  procedure TDelphiParser.&Interface;
  begin
!   try
!     case Look of
!       T_USES:
!         begin
!           Next;
!           repeat
!             Ident;
!             case Look of
!               T_COMMA:     Next;
!               T_SEMICOLON: begin Match(T_SEMICOLON); break; end;
!               else
!                 RaiseException(EExpectedError.Create(TokensToString([T_COMMA, T_SEMICOLON]),
!                                                      TokenToString(fLexer.CurrToken)));
!             end;
!           until False;
!         end;

        T_TYPE:
!         begin
!         end;
! 
        T_VAR:
!         begin
!         end;
! 
        T_CONST:
!         begin
!         end;
! 
        T_RESOURCESTRING:
!         begin
!         end;
! 
!      // TODO: functions
!     end;
!   except
!     on E: Exception do begin
!       HandleException(E);
!       SyncToken(InterfaceSync); &Interface;
      end;
!   end;
  end;

--- 209,318 ----
  end;

! procedure TDelphiParser.DoParse;
! begin
!   // First, we need a root keyword
!   case Look of
!     T_PROGRAM: &Program;
!     T_UNIT:    &Unit;
!     T_LIBRARY:
!       RaiseException(EFatalError.Create('Libraries not yet supported'));
!     T_PACKAGE:
!       RaiseException(EFatalError.Create('Packages not yet supported'));
!     else
!       // TODO: "Root keyword" should be replaced by the token we would automatically
!       // expect after reading the file extension, e.g. "UNIT" for .pas files.
!       UnexpectedToken('Root keyword');
!   end;
! 
!   // If there are still tokens, we ignore them, but notify the user;
!   if Look <> T_NULL then
!     MessageEmitter.Emit(mtHint, E_TEXT_AFTER_END_IGNORED);
! end;

  procedure TDelphiParser.&Program;
  begin
!   Match(T_PROGRAM); Ident; Match(T_SEMICOLON);
!   &Implementation;
!   Block;
! end;

! procedure TDelphiParser.&Unit;
! begin
!   // Unit header
!   Match(T_UNIT); Ident; Match(T_SEMICOLON);

!   // Interface section
!   Match(T_INTERFACE);
!   repeat
!     try
!       &Interface;
!       if Look = T_IMPLEMENTATION then break
!       else UnexpectedToken('Declaration'); // TODO: localize
!     except
!       on E: Exception do begin
!         HandleException(E);
!         SyncToken(InterfaceSync);
!       end;
!     end;
!   until False;

!   // Implementation section
!   Match(T_IMPLEMENTATION);
!   &Implementation;
!   
!   // Initialization section is not required
!   if Look = T_INITIALIZATION then begin
!     Match(T_INITIALIZATION);
!     // TODO: Sync()!
!     //Block;
!     // Finalization section is also not required
!     if Look = T_FINALIZATION then begin
!       Match(T_FINALIZATION);
!       // TODO: Sync()!
!       //Block;
!     end;
!   end
!   else if Look = T_FINALIZATION then
!     RaiseException(EParserError.Create(E_FIN_WITHOUT_INIT))
!   else if Look = T_BEGIN then begin
!     Block(True);
!     exit;   // Block already included the final "end."
!   end;
!   // "end."
!   Match(T_END); Match(T_DOT);
  end;

  procedure TDelphiParser.&Interface;
  begin
!   // There may be a uses-section at the very beginning; Note this is the only
!   // place within interface where this is allowed.
!   // TODO: multiple uses statements should we allowed 
!   if Look = T_USES then
!     try
!       &Uses;
!     except
!       // If there was an error, sync to the implementation part
!       on E: Exception do begin
!         HandleException(E);
!         SyncToken(UsesSync);
!       end;
!     end;

+   // Now we have to expect different section which may be used multiple times  
+   repeat
+     case Look of
        T_TYPE:
!         &Type;
        T_VAR:
!         &Var;
        T_CONST:
!         &Const;
        T_RESOURCESTRING:
!         &ResourceString;
!       else
!         break;  // Caller will raise exception
!       // TODO: functions
      end;
!   until False;
  end;

***************
*** 263,267 ****
  end;

! procedure TDelphiParser.Block;
  begin
    Match(T_BEGIN);
--- 322,326 ----
  end;

! procedure TDelphiParser.Block(EndWithDot: boolean = False);
  begin
    Match(T_BEGIN);
***************
*** 272,276 ****
      on E: Exception do HandleException(E);
    end;
!   Match(T_END); Match(T_SEMICOLON);
  end;

--- 331,339 ----
      on E: Exception do HandleException(E);
    end;
!   Match(T_END);
!   if EndWithDot then
!     Match(T_DOT)
!   else
!     Match(T_SEMICOLON);
  end;

***************
*** 284,286 ****
--- 347,500 ----
  end;

+ procedure TDelphiParser.&Class;
+ begin
+   // Eat class keyword
+   Match(T_CLASS);
+   // There is a left parantheses to define base classes
+   if Look = T_LPAREN then begin
+     Next;
+     Match(T_IDENT);
+     while Look = T_COMMA do begin
+       Next;
+       Ident;
+     end;
+     Match(T_RPAREN);
+   end;
+ 
+   // Either end directly with a semicolon..
+   if Look = T_SEMICOLON then
+     Match(T_SEMICOLON)
+   // .. or there is a definition part
+   else begin
+     // TODO: Parse definitions!
+     Match(T_END); Match(T_SEMICOLON);
+   end;
+ end;
+ 
+ procedure TDelphiParser.&Record;
+ begin
+   // Eat record keyword
+   Match(T_RECORD);
+   
+   // Either end directly with a semicolon..
+   if Look = T_SEMICOLON then
+     Match(T_SEMICOLON)
+   // .. or there is a definition part
+   else begin
+     // TODO: Parse definitions!
+     Match(T_END); Match(T_SEMICOLON);
+   end;
+ end;
+ 
+ procedure TDelphiParser.&Uses;
+ begin
+   // Eat uses-token
+   Match(T_USES);
+   repeat
+     // We need at the very least /one/ identifier
+     Ident;
+     case Look of
+       // If there is a comma, continue the loop to find more idents
+       T_COMMA:
+         Next;
+       // If there is a semicolon, this was the last ident; exit loop;
+       T_SEMICOLON:
+         begin
+           Next;
+           break;  // leave the loop
+         end;
+       // Anything else is unexpected: Show an error message
+       else
+         UnexpectedToken(TokensToString([T_COMMA, T_SEMICOLON]));
+     end;
+   until False;
+ end;
+ 
+ procedure TDelphiParser.&Type;
+ begin
+   // Eat type-token
+   Match(T_TYPE);
+   repeat
+     // Require an identifier followed by a equality operator
+     Match(T_IDENT);
+     Match(T_EQUAL);
+ 
+     // Parse the type identifier after the equality token
+     case Look of
+       T_CLASS:  &Class;
+       T_RECORD: &Record;
+       else      begin TypeIdent; Match(T_SEMICOLON); end;
+     end;
+   until Look <> T_IDENT;
+ end;
+ 
+ procedure TDelphiParser.&Const;
+ begin
+   Match(T_CONST);
+   repeat
+     Match(T_IDENT); Match(T_EQUAL);
+     if Look = T_INT then Match(T_INT)
+     else if Look = T_FLOAT then Match(T_FLOAT)
+     else if Look = T_STRING then Match(T_STRING)
+     else UnexpectedToken(S_TYPE);
+     Match(T_SEMICOLON);
+     if Look <> T_IDENT then break;
+   until False;
+ end;
+ 
+ procedure TDelphiParser.&ResourceString;
+ begin
+ 
+ end;
+ 
+ procedure TDelphiParser.&Var;
+ begin
+   Match(T_VAR);
+   repeat
+     Match(T_IDENT); Match(T_COLON); Ident; Match(T_SEMICOLON);
+     if Look <> T_IDENT then break;
+   until False;
+ end;
+ 
+ procedure TDelphiParser.TypeIdent;
+ begin
+   // Range, e.g. 0..4
+   if Look = T_INT then begin
+     Next;
+     Match(T_DOUBLEDOT);
+     Match(T_INT);
+   end
+   
+   // Array
+   else if Look = T_ARRAY then begin
+     Next;
+     Match(T_LBRACKET);
+       Match(T_INT);
+       Match(T_DOUBLEDOT);
+       Match(T_INT);
+     Match(T_RBRACKET);
+     Match(T_OF);
+     TypeIdent;
+   end
+ 
+   // Enum
+   else if Look = T_LPAREN then begin
+     Next;
+     Match(T_IDENT);
+     while Look = T_COMMA do begin
+       Match(T_COMMA);
+       Match(T_IDENT);
+     end;
+     Match(T_RPAREN);
+   end
+ 
+   // Another Identifier
+   else if Look = T_IDENT then
+     Ident
+ 
+   // Anything else is a syntax error
+   else
+     UnexpectedToken(S_TYPE);
+ end;
+ 
  end.

Index: fdcil.dpr
===================================================================
RCS file: /cvsroot/fdcil/dev/miracle2k/fdcil-test/fdcil.dpr,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** fdcil.dpr	15 Aug 2004 11:34:46 -0000	1.2
--- fdcil.dpr	16 Aug 2004 18:54:00 -0000	1.3
***************
*** 28,32 ****
    fdcil.Tokens in 'fdcil.Tokens.pas',
    fdcil.Compiler in 'fdcil.Compiler.pas',
-   fdcil.Tokenizer in 'fdcil.Tokenizer.pas',
    fdcil.Lexer in 'fdcil.Lexer.pas',
    fdcil.Parser in 'fdcil.Parser.pas',
--- 28,31 ----

Index: fdcil.bdsproj
===================================================================
RCS file: /cvsroot/fdcil/dev/miracle2k/fdcil-test/fdcil.bdsproj,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** fdcil.bdsproj	15 Aug 2004 11:34:46 -0000	1.2
--- fdcil.bdsproj	16 Aug 2004 18:54:00 -0000	1.3
***************
*** 157,165 ****
  			<VersionInfo Name="Locale" Type="Integer">1031</VersionInfo>
  			<VersionInfo Name="CodePage" Type="Integer">1252</VersionInfo>
! 		</VersionInfo>  <FileList>
        <File FileName="fdcil.CommandLine.pas" ContainerId="" ModuleName="fdcil.CommandLine"/>
        <File FileName="fdcil.Tokens.pas" ContainerId="" ModuleName="fdcil.Tokens"/>
        <File FileName="fdcil.Compiler.pas" ContainerId="" ModuleName="fdcil.Compiler"/>
-       <File FileName="fdcil.Tokenizer.pas" ContainerId="" ModuleName="fdcil.Tokenizer"/>
        <File FileName="fdcil.Lexer.pas" ContainerId="" ModuleName="fdcil.Lexer"/>
        <File FileName="fdcil.Parser.pas" ContainerId="" ModuleName="fdcil.Parser"/>
--- 157,167 ----
  			<VersionInfo Name="Locale" Type="Integer">1031</VersionInfo>
  			<VersionInfo Name="CodePage" Type="Integer">1252</VersionInfo>
! 		</VersionInfo>  
!     
!     
!     <FileList>
        <File FileName="fdcil.CommandLine.pas" ContainerId="" ModuleName="fdcil.CommandLine"/>
        <File FileName="fdcil.Tokens.pas" ContainerId="" ModuleName="fdcil.Tokens"/>
        <File FileName="fdcil.Compiler.pas" ContainerId="" ModuleName="fdcil.Compiler"/>
        <File FileName="fdcil.Lexer.pas" ContainerId="" ModuleName="fdcil.Lexer"/>
        <File FileName="fdcil.Parser.pas" ContainerId="" ModuleName="fdcil.Parser"/>

Index: test.pas
===================================================================
RCS file: /cvsroot/fdcil/dev/miracle2k/fdcil-test/test.pas,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** test.pas	15 Aug 2004 11:34:47 -0000	1.2
--- test.pas	16 Aug 2004 18:54:00 -0000	1.3
***************
*** 3,14 ****
  interface

! uses SysUtils

- uses Windows,

- uses Math, 

  implementation

  end.
--- 3,38 ----
  interface

! uses Windows;
! 
! const
!   s = 
!   i = 8;
! 
! 
! type
!   tsert = (sdf, dsdf);
! 
!   MyClass = class(Test1, Test2);
! 
!   MyClass2 = class(Tet1, Test2, I3)
!   end;
! 
! 
! type
!   Someting = array[1..2] of test;
! 
! var
!   test: string;
! 
! var test: integer;

  implementation

+ begin
+ 
  end.
+ 
+ Ignored Text

Index: fdcil.Lexer.pas
===================================================================
RCS file: /cvsroot/fdcil/dev/miracle2k/fdcil-test/fdcil.Lexer.pas,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** fdcil.Lexer.pas	15 Aug 2004 11:34:46 -0000	1.2
--- fdcil.Lexer.pas	16 Aug 2004 18:54:00 -0000	1.3
***************
*** 519,525 ****
    end;

!   procedure &Symbol;     // TODO: use symbol table to load tokens
    begin
      Value := Look;
      case Look of
        '+': Token := T_ADD_OP;
--- 519,526 ----
    end;

!   procedure &Symbol;     
    begin
      Value := Look;
+     // TODO: This is already in the symbol table, use the data there to decide which symbol we have found
      case Look of
        '+': Token := T_ADD_OP;
***************
*** 546,550 ****
        ':': Token := T_COLON;
        ';': Token := T_SEMICOLON;
!       '.': Token := T_DOT;
        ',': Token := T_COMMA;
        '&': Token := T_AMPERSAND;
--- 547,555 ----
        ':': Token := T_COLON;
        ';': Token := T_SEMICOLON;
!       '.': begin
!              GetChar;
!              if Look = '.' then begin Token := T_DOUBLEDOT; Value := Value + Look; end
!              else begin Token := T_DOT; exit; end;
!            end;
        ',': Token := T_COMMA;
        '&': Token := T_AMPERSAND;
***************
*** 563,567 ****
        if Look = '''' then begin
          GetChar;
!         if not (Look = '''') then break
          else Value := Value + '''';
        end;
--- 568,572 ----
        if Look = '''' then begin
          GetChar;
!         if not (Look = '''') then exit
          else Value := Value + '''';
        end;
***************
*** 622,626 ****
               if Look = '$' then CompilerDirective;
               Comment;
!            end;
           end;

--- 627,631 ----
               if Look = '$' then CompilerDirective;
               Comment;
!            end else Token := T_LPAREN;
           end;

Index: fdcil.Tokens.pas
===================================================================
RCS file: /cvsroot/fdcil/dev/miracle2k/fdcil-test/fdcil.Tokens.pas,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** fdcil.Tokens.pas	15 Aug 2004 11:34:46 -0000	1.2
--- fdcil.Tokens.pas	16 Aug 2004 18:54:00 -0000	1.3
***************
*** 54,57 ****
--- 54,62 ----
    T_INITIALIZATION   = 2013;
    T_FINALIZATION     = 2014;
+   T_CLASS            = 2015;
+   T_RECORD           = 2016;
+   T_ARRAY            = 2017;
+   T_OF               = 2018;
+   T_AS               = 2019;  

    // Operators
***************
*** 71,75 ****
    T_LPAREN           = 4001;
    T_RPAREN           = 4002;
!   T_LBRACKET         = 4003;
    T_RBRACKET         = 4003;
    T_COLON            = 4005;
--- 76,80 ----
    T_LPAREN           = 4001;
    T_RPAREN           = 4002;
!   T_LBRACKET         = 4003;  // TODO: is this the right name?
    T_RBRACKET         = 4003;
    T_COLON            = 4005;
***************
*** 78,86 ****
    T_POINTER          = 4008;
    T_EQUAL            = 4009;
!   T_DOT              = 4010;
    T_COMMA            = 4011;
    T_SHARP            = 4012;
    T_AMPERSAND        = 4013;
!   T_HOCHKOMMA        = 4014;

    // Other tokens
--- 83,92 ----
    T_POINTER          = 4008;
    T_EQUAL            = 4009;
!   T_DOT              = 4010;   // TODO: is this the right name?
    T_COMMA            = 4011;
    T_SHARP            = 4012;
    T_AMPERSAND        = 4013;
!   T_HOCHKOMMA        = 4014; // TODO: english name?
!   T_DOUBLEDOT        = 4015;

    // Other tokens

Index: fdcil.IO.Messages.Localize.pas
===================================================================
RCS file: /cvsroot/fdcil/dev/miracle2k/fdcil-test/fdcil.IO.Messages.Localize.pas,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** fdcil.IO.Messages.Localize.pas	15 Aug 2004 11:34:46 -0000	1.2
--- fdcil.IO.Messages.Localize.pas	16 Aug 2004 18:54:00 -0000	1.3
***************
*** 26,30 ****
  resourcestring
    E_FILE_NOT_FOUND         = 'File not found: ''{0}''';
!   E_TEXT_AFTER_END_IGNORED = 'Text after final ''End.'' is ignored by compiler';

    E_UNEXPECTED             = '{0} expected but {1} found';
--- 26,30 ----
  resourcestring
    E_FILE_NOT_FOUND         = 'File not found: ''{0}''';
!   E_TEXT_AFTER_END_IGNORED = 'Text after final ''END.'' is ignored by compiler';

    E_UNEXPECTED             = '{0} expected but {1} found';
***************
*** 32,37 ****

    S_END_OF_FILE            = 'end of file';
-   S_IDENTIFIER             = 'identifier';
    S_OR                     = 'or';

  implementation
--- 32,47 ----

    S_END_OF_FILE            = 'end of file';
    S_OR                     = 'or';
+   S_IDENTIFIER_PREFIX      = 'identifier';
+   
+   S_IDENTIFIER             = 'Identifier';
+   S_TYPE                   = 'Type';
+   S_DECLARATION            = 'Declaration';
+   S_NUMBER                 = 'number';
+   S_FLOAT                  = 'real constant';
+ 
+   S_FATAL_ERROR            = 'Fatal Error';
+   S_ERROR                  = 'Error';
+   S_HINT                   = 'Hint';

  implementation

Index: fdcil.IO.Messages.pas
===================================================================
RCS file: /cvsroot/fdcil/dev/miracle2k/fdcil-test/fdcil.IO.Messages.pas,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** fdcil.IO.Messages.pas	15 Aug 2004 11:34:46 -0000	1.2
--- fdcil.IO.Messages.pas	16 Aug 2004 18:54:00 -0000	1.3
***************
*** 24,37 ****
  interface

  type
    TMessageType = (mtFatal, mtError, mtHint);
!   
    TMessageEmitter = class(System.Object)
    protected
      function MessageTypeToString(MessageType: TMessageType): string;
    public
      procedure Emit(MessageType: TMessageType; Message: string); overload;
!     procedure Emit(MessageType: TMessageType; Line, Col: Integer;
!       Message: string); overload;
    end;

--- 24,47 ----
  interface

+ uses
+   fdcil.ExceptionHandling;
+ 
  type
    TMessageType = (mtFatal, mtError, mtHint);
! 
    TMessageEmitter = class(System.Object)
+   private
+     FCurrFileName: string;
    protected
      function MessageTypeToString(MessageType: TMessageType): string;
    public
      procedure Emit(MessageType: TMessageType; Message: string); overload;
!     procedure Emit(MessageType: TMessageType; E: EfdcilError); overload;
! 
!     // This is the filename used in the output messages; It is updated by the
!     // TCompiler object everytime it tries to compile a new file; an alternative
!     // (and maybe better) solution would be to add a new FileName property to
!     // the base EfdcilError exception class.
!     property CurrFileName: string read fCurrFileName write fCurrFileName; 
    end;

***************
*** 40,43 ****
--- 50,56 ----
  implementation

+ uses
+   fdcil.IO.Messages.Localize;
+ 
  var
    InternalMessageEmitter: TMessageEmitter = nil;
***************
*** 52,57 ****
  { TMessageEmitter }

- // TODO: add a MessageEmitter.Emit(E: Exception) method?
- 
  procedure TMessageEmitter.Emit(MessageType: TMessageType; Message: string);
  begin
--- 65,68 ----
***************
*** 59,68 ****
  end;

! procedure TMessageEmitter.Emit(MessageType: TMessageType; Line,
!   Col: Integer; Message: string);
  begin
-   // TODO: 'filename' needs to be passed
    Console.WriteLine('[' + MessageTypeToString(MessageType) + '] ' +
!                     'FileName(' + Line.ToString() + '): ' + Message);
  end;

--- 70,77 ----
  end;

! procedure TMessageEmitter.Emit(MessageType: TMessageType; E: EfdcilError);
  begin
    Console.WriteLine('[' + MessageTypeToString(MessageType) + '] ' +
!                     CurrFileName + '(' + E.Line.ToString() + '): ' + E.Message);
  end;

***************
*** 71,77 ****
  begin
    case MessageType of
!     mtFatal: Result := 'Fatal Error';
!     mtError: Result := 'Error';
!     mtHint:  Result := 'Hint';
      else
        raise Exception.Create('Description for message type is missing');
--- 80,86 ----
  begin
    case MessageType of
!     mtFatal: Result := S_FATAL_ERROR;
!     mtError: Result := S_ERROR;
!     mtHint:  Result := S_HINT;
      else
        raise Exception.Create('Description for message type is missing');

Index: fdcil.SymbolTable.pas
===================================================================
RCS file: /cvsroot/fdcil/dev/miracle2k/fdcil-test/fdcil.SymbolTable.pas,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** fdcil.SymbolTable.pas	15 Aug 2004 11:34:46 -0000	1.2
--- fdcil.SymbolTable.pas	16 Aug 2004 18:54:00 -0000	1.3
***************
*** 29,34 ****
  type
    TSymbol = record
!     IsSpecial: Boolean;
!     Token: Integer;
    end;

--- 29,38 ----
  type
    TSymbol = record
!   public
!     TokenID: Integer;
!     IsSpecial: boolean;    // Either a keyword or an operator
!   public
!     function Equals(obj: TObject): Boolean; override;
!     function GetHashCode: Integer; override;
    end;

***************
*** 37,47 ****
      fSymbols: HashTable;
    protected
!     function MakeSymbol(IsSpecial: Boolean; Token: Integer): TSymbol;
    public
      constructor Create;
      procedure Init;

!     procedure AddKeyword(Name: string; Symbol: TSymbol);
      function QueryKeyword(Keyword: string): Integer;
    end;

--- 41,52 ----
      fSymbols: HashTable;
    protected
!     function MakeSymbol(TokenID: Integer): TSymbol;
    public
      constructor Create;
      procedure Init;

!     procedure AddSymbol(Name: string; Symbol: TSymbol);
      function QueryKeyword(Keyword: string): Integer;
+     function KeywordToString(Keyword: integer): string;
    end;

***************
*** 53,58 ****
  { TSymbolTable }

! procedure TSymbolTable.AddKeyword(Name: string; Symbol: TSymbol);
  begin
    fSymbols.Add(Symbol, Name);
    fSymbols.Add(Name, Symbol);
--- 58,64 ----
  { TSymbolTable }

! procedure TSymbolTable.AddSymbol(Name: string; Symbol: TSymbol);
  begin
+   Name := Name.ToLower;
    fSymbols.Add(Symbol, Name);
    fSymbols.Add(Name, Symbol);
***************
*** 67,94 ****
  procedure TSymbolTable.Init;
  begin
!   AddKeyword('program',   MakeSymbol(True, T_PROGRAM));
!   AddKeyword('unit',      MakeSymbol(True, T_UNIT));
!   AddKeyword('library',   MakeSymbol(True, T_LIBRARY));
!   AddKeyword('package',   MakeSymbol(True, T_PACKAGE));
!   AddKeyword('interface', MakeSymbol(True, T_INTERFACE));
!   AddKeyword('implementation', MakeSymbol(True, T_IMPLEMENTATION));
!   AddKeyword('uses',      MakeSymbol(True, T_USES));
!   AddKeyword('begin',     MakeSymbol(True, T_BEGIN));
!   AddKeyword('end',       MakeSymbol(True, T_END));
!   AddKeyword('if',        MakeSymbol(True, T_IF));
!   AddKeyword('then',      MakeSymbol(True, T_THEN));
!   AddKeyword('else',      MakeSymbol(True, T_ELSE));
!   AddKeyword('div',       MakeSymbol(True, T_INT_DIVIDE_OP));
!   AddKeyword('mod',       MakeSymbol(True, T_MODULO));

!   AddKeyword('<',         MakeSymbol(True, T_LT_OP));
!   AddKeyword('>',         MakeSymbol(True, T_GT_OP));
  end;

! function TSymbolTable.MakeSymbol(IsSpecial: Boolean;
!   Token: Integer): TSymbol;
  begin
!   Result.IsSpecial := IsSpecial;
!   Result.Token := Token;
  end;

--- 73,128 ----
  procedure TSymbolTable.Init;
  begin
!   // Keywords
!   AddSymbol('program',         MakeSymbol(T_PROGRAM));
!   AddSymbol('unit',            MakeSymbol(T_UNIT));
!   AddSymbol('library',         MakeSymbol(T_LIBRARY));
!   AddSymbol('package',         MakeSymbol(T_PACKAGE));
!   AddSymbol('interface',       MakeSymbol(T_INTERFACE));
!   AddSymbol('implementation',  MakeSymbol(T_IMPLEMENTATION));
!   AddSymbol('initialization',  MakeSymbol(T_INITIALIZATION));
!   AddSymbol('finalization',    MakeSymbol(T_FINALIZATION));
!   AddSymbol('uses',            MakeSymbol(T_USES));
!   AddSymbol('class',           MakeSymbol(T_CLASS));
!   AddSymbol('record',          MakeSymbol(T_RECORD));
!   AddSymbol('array',           MakeSymbol(T_ARRAY));
!   AddSymbol('type',            MakeSymbol(T_TYPE));
!   AddSymbol('var',             MakeSymbol(T_VAR));
!   AddSymbol('const',           MakeSymbol(T_CONST));
!   AddSymbol('begin',           MakeSymbol(T_BEGIN));
!   AddSymbol('end',             MakeSymbol(T_END));
!   AddSymbol('if',              MakeSymbol(T_IF));
!   AddSymbol('then',            MakeSymbol(T_THEN));
!   AddSymbol('else',            MakeSymbol(T_ELSE));
!   AddSymbol('div',             MakeSymbol(T_INT_DIVIDE_OP));
!   AddSymbol('mod',             MakeSymbol(T_MODULO));
!   AddSymbol('of',              MakeSymbol(T_OF));
!   AddSymbol('as',              MakeSymbol(T_AS));

!   // Just symbols, but we use this to convert the token ids to a string
!   AddSymbol(';',               MakeSymbol(T_SEMICOLON));
!   AddSymbol('(',               MakeSymbol(T_LPAREN));
!   AddSymbol(')',               MakeSymbol(T_RPAREN));
!   AddSymbol('.',               MakeSymbol(T_DOT));
!   AddSymbol(',',               MakeSymbol(T_COMMA));
!   AddSymbol('<',               MakeSymbol(T_LT_OP));
!   AddSymbol('>',               MakeSymbol(T_GT_OP));
  end;

! function TSymbolTable.KeywordToString(Keyword: integer): string;
! var
!   HashValue: System.Object;
!   tempSymbol: TSymbol;
  begin
!   Result := Keyword.ToString();
!   tempSymbol.TokenID := Keyword;
!   HashValue := fSymbols.Item[System.Object(tempSymbol)];
!   if HashValue <> nil then
!     Result := System.String(HashValue).ToUpper;
! end;
! 
! function TSymbolTable.MakeSymbol(TokenID: Integer): TSymbol;
! begin
!   Result.IsSpecial := True;
!   Result.TokenID := TokenID;
  end;

***************
*** 98,104 ****
  begin
    Result := T_NULL;
!   HashValue := fSymbols.Item[Keyword];
    if HashValue <> nil then
!     Result := TSymbol(HashValue).Token;
  end;

--- 132,153 ----
  begin
    Result := T_NULL;
!   HashValue := fSymbols.Item[Keyword.ToLower];
    if HashValue <> nil then
!     Result := TSymbol(HashValue).TokenID;
! end;
! 
! { TSymbol }
! 
! function TSymbol.Equals(obj: TObject): Boolean;
! begin
!   if obj is TSymbol then
!     Result := TSymbol(obj).TokenID = Self.TokenID
!   else
!     Result := False;
! end;
! 
! function TSymbol.GetHashCode: Integer;
! begin
!    Result := Self.TokenID;
  end;

Index: fdcil.ExceptionHandling.pas
===================================================================
RCS file: /cvsroot/fdcil/dev/miracle2k/fdcil-test/fdcil.ExceptionHandling.pas,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** fdcil.ExceptionHandling.pas	15 Aug 2004 11:34:46 -0000	1.2
--- fdcil.ExceptionHandling.pas	16 Aug 2004 18:54:00 -0000	1.3
***************
*** 33,39 ****
--- 33,41 ----
      fLine: Integer;
      fColumn: Integer;
+     //fFileName: string;
    public
      property Line: Integer read fLine write fLine;
      property Column: Integer read fColumn write fColumn;
+     //property FileName: string read fFileName write fFileName;
    end;

***************
*** 50,55 ****
    StatementSync: array[0..2] of Integer =
       (T_SEMICOLON, T_BEGIN, T_END);
!   InterfaceSync: array[1..5] of Integer =
!      (T_USES, T_TYPE, T_VAR, T_CONST, T_IMPLEMENTATION);

  implementation
--- 52,59 ----
    StatementSync: array[0..2] of Integer =
       (T_SEMICOLON, T_BEGIN, T_END);
!   InterfaceSync: array[1..4] of Integer =
!      (T_TYPE, T_VAR, T_CONST, T_IMPLEMENTATION);
!   UsesSync: array[1..1] of Integer =
!      (T_IMPLEMENTATION);

  implementation

fdcil-cvs Mailing List for Free Pascal Compiler for IL

fdcil-cvs — Keep track to CVS commits