Changeset 72 for branches/Transpascal/Compiler/Analyze/UParser.pas

Timestamp:

Oct 20, 2010, 11:02:10 AM (14 years ago)

Author:

george

Message:

• Fixed: Better error message cursor position focusing.
• Modified: All source code is tokenized to token list at once.

File:

• branches/Transpascal/Compiler/Analyze/UParser.pas (modified) (12 diffs)

branches/Transpascal/Compiler/Analyze/UParser.pas

@@ -6 +6 @@
 
 uses
-  SysUtils, Variants, Classes,
+  SysUtils, Variants, Classes, Contnrs,
   Dialogs, USourceCode, FileUtil;
 
@@ -19 +19 @@
     ttOperator, ttEndOfFile, ttLineComment, ttBlockComment1, ttBlockComment2,
     ttUnknown, ttWhiteSpace);
+
+  TToken = class
+    Token: string;
+    CodePosition: TPoint;
+    TokenType: TTokenType;
+  end;
 
   { TBaseParser }
@@ -29 +35 @@
     FNextTokenType: TTokenType;
     FParserState: TParserState;
-    PreviousChar: char;
-    CurrentChar: char;
+    PreviousChar: Char;
+    CurrentChar: Char;
+    TokenCodePosition: TPoint;
+    procedure GetNextToken;
   public
     ProgramCode: TProgram;
-    CodeStreamPosition: integer;
+    CodeStreamPosition: Integer;
     CodePosition: TPoint;
-    LastTokenEnd: TPoint;
-    LastTokenStart: TPoint;
     SourceCodeText: TStringList;
+    Tokens: TObjectList; // TObjectList<TToken>
+    TokenIndex: Integer;
+    constructor Create;
+    destructor Destroy; override;
     function IsAlphanumeric(Character: char): boolean;
-    procedure GetNextToken;
-    function ReadCode: string;
-    function NextToken: string;
-    function NextTokenType: TTokenType;
-    procedure Expect(Code: string);
     function IsWhiteSpace(Character: char): boolean;
     function IsAlphabetic(Character: char): boolean;
@@ -49 +54 @@
     function IsKeyword(Text: string): boolean;
     function IsOperator(Text: string): boolean;
-    procedure Log(Text: string);
-    procedure ErrorMessage(const Text: string; const Arguments: array of const);
+    function ReadCode: string;
+    function NextToken: string;
+    function NextTokenType: TTokenType;
+    procedure Expect(Code: string);
+    procedure ErrorMessage(const Text: string; const Arguments: array of const;
+      TokenOffset: Integer);
     property OnErrorMessage: TOnErrorMessage read FOnErrorMessage write FOnErrorMessage;
-    procedure Init;
+    procedure Process;
     property FileName: string read FFileName write FFileName;
   end;
 
 resourcestring
-  SUnknownIdentifier = 'Unknown identificator "%s".';
-  SIllegalExpression = 'Illegal expression "%s".';
   SExpectedButFound = 'Expected "%s" but "%s" found.';
-  SRedefineIdentifier = 'Identificator "%s" redefinition.';
-  STypeNotDefined = 'Type "%s" not defined.';
-  SEndOfDataReached = 'Parser reached to end of input data.';
-  SUndefinedVariable = 'Undefined variable "%s".';
-  SUndefinedType = 'Undefined type "%s".';
-  SUndefinedConstant = 'Undefined constant "%s".';
-  SUnitNotFound = 'Unit "%s" not found.';
 
 implementation
@@ -72 +72 @@
 { TBaseParser }
 
-procedure TBaseParser.ErrorMessage(const Text: string; const Arguments: array of const);
+procedure TBaseParser.ErrorMessage(const Text: string; const Arguments: array of const;
+  TokenOffset: Integer);
 begin
   if Assigned(FOnErrorMessage) then
-    FOnErrorMessage(Format(Text, Arguments), LastTokenStart, FileName);
+  if (TokenIndex + TokenOffset) < Tokens.Count then begin
+    FOnErrorMessage(Format(Text, Arguments),
+      TToken(Tokens[TokenIndex + TokenOffset]).CodePosition, FileName);
+  end;
 end;
 
 procedure TBaseParser.Expect(Code: string);
 begin
-  Log('Expected: ' + Code + '  Readed: ' + FNextToken);
-  if FNextToken <> Code then begin
-    //ReadCode;
-    ErrorMessage(SExpectedButFound, [Code, FNextToken]);
+  if NextToken <> Code then begin
+    ErrorMessage(SExpectedButFound, [Code, FNextToken], -2);
 
     // Recovery: try to find nearest same code
-    while (FNextToken <> Code) and (FNextTokenType <> ttEndOfFile) do
-      GetNextToken;
-  end;
-  GetNextToken;
+    while (NextToken <> Code) and (NextTokenType <> ttEndOfFile) do
+      ReadCode;
+  end;
+  ReadCode;
 end;
 
@@ -95 +97 @@
 begin
   Result := (Character in ['a'..'z']) or (Character in ['A'..'Z']);
+end;
+
+constructor TBaseParser.Create;
+begin
+  Tokens := TObjectList.Create;
+end;
+
+destructor TBaseParser.Destroy;
+begin
+  Tokens.Free;
+  inherited Destroy;
 end;
 
@@ -144 +157 @@
 end;
 
-procedure TBaseParser.Log(Text: string);
-const
-  LogFileName = 'ParseLog.txt';
-var
-  LogFile: TFileStream;
-begin
-  try
-    if FileExistsUTF8(LogFileName) { *Converted from FileExists*  } then
-      LogFile := TFileStream.Create(LogFileName, fmOpenWrite)
-    else
-      LogFile := TFileStream.Create(LogFileName, fmCreate);
-    if Length(Text) > 0 then
-    begin
-      LogFile.Write(Text[1], Length(Text));
-      LogFile.Write(#13#10, 2);
-    end;
-  finally
-    LogFile.Free;
-  end;
-end;
-
-procedure TBaseParser.Init;
-begin
-  CodePosition := Point(1, 1);
+procedure TBaseParser.Process;
+var
+  NewToken: TToken;
+begin
+  CodePosition := Point(0, 1);
   CurrentChar := #0;
   PreviousChar := #0;
@@ -173 +167 @@
   FNextTokenType := ttNone;
   CodeStreamPosition := 1;
-  GetNextToken;
+  Tokens.Clear;
+  TokenIndex := 0;
+  while CodeStreamPosition < Length(SourceCodeText.Text) do begin
+    NewToken := TToken.Create;
+    GetNextToken;
+    NewToken.CodePosition := TokenCodePosition;
+    NewToken.TokenType := FNextTokenType;
+    NewToken.Token := FNextToken;
+    Tokens.Add(NewToken);
+  end;
 end;
 
@@ -184 +187 @@
   SpecChar: set of char = [';', '.', ',', ':', '(', ')', '[', ']',
     '+', '-', '/', '*', '^', '=', '<', '>', '@'];
-  DoubleSpecChar: array[0..6] of string = (':=', '..', '<=', '>=', '<>', '+=', '-=');
-begin
-  LastTokenStart := LastTokenEnd;
-  LastTokenEnd := CodePosition;
+  DoubleSpecChar: array[0..6] of string = (':=', '..', '<=', '>=', '<>',
+    '+=', '-=');
+begin
   FNextToken := '';
   FNextTokenType := ttNone;
   FParserState := psNone;
   with SourceCodeText do
-    while True do
-    begin
+    while True do begin
       if CodeStreamPosition < Length(Text) then begin
         CurrentChar := Text[CodeStreamPosition];
@@ -204 +205 @@
 
       if FParserState = psNone then begin
+        TokenCodePosition := CodePosition;
         if IsWhiteSpace(CurrentChar) then
           FParserState := psWhiteSpace
@@ -293 +295 @@
         Inc(CodePosition.X);
         if (CurrentChar = #13) then begin
-          CodePosition.X := 1;
+          CodePosition.X := 0;
           Inc(CodePosition.Y);
         end;
@@ -305 +307 @@
 function TBaseParser.ReadCode: string;
 begin
-  Result := FNextToken;
-  GetNextToken;
-  Log('Read: ' + Result);
+  if TokenIndex < Tokens.Count then begin
+    Result := TToken(Tokens[TokenIndex]).Token;
+    Inc(TokenIndex);
+  end else Result := '';
 end;
 
 function TBaseParser.NextToken: string;
 begin
-  Result := FNextToken;
+  if TokenIndex < Tokens.Count then begin
+    Result := TToken(Tokens[TokenIndex]).Token;
+  end else Result := '';
 end;
 
 function TBaseParser.NextTokenType: TTokenType;
 begin
-  Result := FNextTokenType;
+  if TokenIndex < Tokens.Count then begin
+    Result := TToken(Tokens[TokenIndex]).TokenType;
+  end else Result := ttEndOfFile;
 end;