[Fdcil-cvs] dev/miracle2k/fdcil-test fdcil.Compiler.pas,1.2,1.3 fdcil.ExceptionHandling.pas,1.2,1.3
Status: Planning
Brought to you by:
miracle2k
|
From: Michael E. <mir...@us...> - 2004-08-16 18:54:12
|
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 |