Ignore:
Timestamp:
Oct 20, 2010, 11:02:10 AM (15 years ago)
Author:
george
Message:
  • Fixed: Better error message cursor position focusing.
  • Modified: All source code is tokenized to token list at once.
Location:
branches/Transpascal/Compiler
Files:
5 edited

Legend:

Unmodified
Added
Removed

  • branches/Transpascal/Compiler/Analyze/UParser.pas

    r71 r72  
    66
    77uses
    8   SysUtils, Variants, Classes,
     8  SysUtils, Variants, Classes, Contnrs,
    99  Dialogs, USourceCode, FileUtil;
    1010
    … …  
    1919    ttOperator, ttEndOfFile, ttLineComment, ttBlockComment1, ttBlockComment2,
    2020    ttUnknown, ttWhiteSpace);
     21
     22  TToken = class
     23    Token: string;
     24    CodePosition: TPoint;
     25    TokenType: TTokenType;
     26  end;
    2127
    2228  { TBaseParser }
    … …  
    2935    FNextTokenType: TTokenType;
    3036    FParserState: TParserState;
    31     PreviousChar: char;
    32     CurrentChar: char;
     37    PreviousChar: Char;
     38    CurrentChar: Char;
     39    TokenCodePosition: TPoint;
     40    procedure GetNextToken;
    3341  public
    3442    ProgramCode: TProgram;
    35     CodeStreamPosition: integer;
     43    CodeStreamPosition: Integer;
    3644    CodePosition: TPoint;
    37     LastTokenEnd: TPoint;
    38     LastTokenStart: TPoint;
    3945    SourceCodeText: TStringList;
     46    Tokens: TObjectList; // TObjectList<TToken>
     47    TokenIndex: Integer;
     48    constructor Create;
     49    destructor Destroy; override;
    4050    function IsAlphanumeric(Character: char): boolean;
    41     procedure GetNextToken;
    42     function ReadCode: string;
    43     function NextToken: string;
    44     function NextTokenType: TTokenType;
    45     procedure Expect(Code: string);
    4651    function IsWhiteSpace(Character: char): boolean;
    4752    function IsAlphabetic(Character: char): boolean;
    … …  
    4954    function IsKeyword(Text: string): boolean;
    5055    function IsOperator(Text: string): boolean;
    51     procedure Log(Text: string);
    52     procedure ErrorMessage(const Text: string; const Arguments: array of const);
     56    function ReadCode: string;
     57    function NextToken: string;
     58    function NextTokenType: TTokenType;
     59    procedure Expect(Code: string);
     60    procedure ErrorMessage(const Text: string; const Arguments: array of const;
     61      TokenOffset: Integer);
    5362    property OnErrorMessage: TOnErrorMessage read FOnErrorMessage write FOnErrorMessage;
    54     procedure Init;
     63    procedure Process;
    5564    property FileName: string read FFileName write FFileName;
    5665  end;
    5766
    5867resourcestring
    59   SUnknownIdentifier = 'Unknown identificator "%s".';
    60   SIllegalExpression = 'Illegal expression "%s".';
    6168  SExpectedButFound = 'Expected "%s" but "%s" found.';
    62   SRedefineIdentifier = 'Identificator "%s" redefinition.';
    63   STypeNotDefined = 'Type "%s" not defined.';
    64   SEndOfDataReached = 'Parser reached to end of input data.';
    65   SUndefinedVariable = 'Undefined variable "%s".';
    66   SUndefinedType = 'Undefined type "%s".';
    67   SUndefinedConstant = 'Undefined constant "%s".';
    68   SUnitNotFound = 'Unit "%s" not found.';
    6969
    7070implementation
    … …  
    7272{ TBaseParser }
    7373
    74 procedure TBaseParser.ErrorMessage(const Text: string; const Arguments: array of const);
     74procedure TBaseParser.ErrorMessage(const Text: string; const Arguments: array of const;
     75  TokenOffset: Integer);
    7576begin
    7677  if Assigned(FOnErrorMessage) then
    77     FOnErrorMessage(Format(Text, Arguments), LastTokenStart, FileName);
     78  if (TokenIndex + TokenOffset) < Tokens.Count then begin
     79    FOnErrorMessage(Format(Text, Arguments),
     80      TToken(Tokens[TokenIndex + TokenOffset]).CodePosition, FileName);
     81  end;
    7882end;
    7983
    8084procedure TBaseParser.Expect(Code: string);
    8185begin
    82   Log('Expected: ' + Code + '  Readed: ' + FNextToken);
    83   if FNextToken <> Code then begin
    84     //ReadCode;
    85     ErrorMessage(SExpectedButFound, [Code, FNextToken]);
     86  if NextToken <> Code then begin
     87    ErrorMessage(SExpectedButFound, [Code, FNextToken], -2);
    8688
    8789    // Recovery: try to find nearest same code
    88     while (FNextToken <> Code) and (FNextTokenType <> ttEndOfFile) do
    89       GetNextToken;
    90   end;
    91   GetNextToken;
     90    while (NextToken <> Code) and (NextTokenType <> ttEndOfFile) do
     91      ReadCode;
     92  end;
     93  ReadCode;
    9294end;
    9395
    … …  
    9597begin
    9698  Result := (Character in ['a'..'z']) or (Character in ['A'..'Z']);
     99end;
     100
     101constructor TBaseParser.Create;
     102begin
     103  Tokens := TObjectList.Create;
     104end;
     105
     106destructor TBaseParser.Destroy;
     107begin
     108  Tokens.Free;
     109  inherited Destroy;
    97110end;
    98111
    … …  
    144157end;
    145158
    146 procedure TBaseParser.Log(Text: string);
    147 const
    148   LogFileName = 'ParseLog.txt';
    149 var
    150   LogFile: TFileStream;
    151 begin
    152   try
    153     if FileExistsUTF8(LogFileName) { *Converted from FileExists*  } then
    154       LogFile := TFileStream.Create(LogFileName, fmOpenWrite)
    155     else
    156       LogFile := TFileStream.Create(LogFileName, fmCreate);
    157     if Length(Text) > 0 then
    158     begin
    159       LogFile.Write(Text[1], Length(Text));
    160       LogFile.Write(#13#10, 2);
    161     end;
    162   finally
    163     LogFile.Free;
    164   end;
    165 end;
    166 
    167 procedure TBaseParser.Init;
    168 begin
    169   CodePosition := Point(1, 1);
     159procedure TBaseParser.Process;
     160var
     161  NewToken: TToken;
     162begin
     163  CodePosition := Point(0, 1);
    170164  CurrentChar := #0;
    171165  PreviousChar := #0;
    … …  
    173167  FNextTokenType := ttNone;
    174168  CodeStreamPosition := 1;
    175   GetNextToken;
     169  Tokens.Clear;
     170  TokenIndex := 0;
     171  while CodeStreamPosition < Length(SourceCodeText.Text) do begin
     172    NewToken := TToken.Create;
     173    GetNextToken;
     174    NewToken.CodePosition := TokenCodePosition;
     175    NewToken.TokenType := FNextTokenType;
     176    NewToken.Token := FNextToken;
     177    Tokens.Add(NewToken);
     178  end;
    176179end;
    177180
    … …  
    184187  SpecChar: set of char = [';', '.', ',', ':', '(', ')', '[', ']',
    185188    '+', '-', '/', '*', '^', '=', '<', '>', '@'];
    186   DoubleSpecChar: array[0..6] of string = (':=', '..', '<=', '>=', '<>', '+=', '-=');
    187 begin
    188   LastTokenStart := LastTokenEnd;
    189   LastTokenEnd := CodePosition;
     189  DoubleSpecChar: array[0..6] of string = (':=', '..', '<=', '>=', '<>',
     190    '+=', '-=');
     191begin
    190192  FNextToken := '';
    191193  FNextTokenType := ttNone;
    192194  FParserState := psNone;
    193195  with SourceCodeText do
    194     while True do
    195     begin
     196    while True do begin
    196197      if CodeStreamPosition < Length(Text) then begin
    197198        CurrentChar := Text[CodeStreamPosition];
    … …  
    204205
    205206      if FParserState = psNone then begin
     207        TokenCodePosition := CodePosition;
    206208        if IsWhiteSpace(CurrentChar) then
    207209          FParserState := psWhiteSpace
    … …  
    293295        Inc(CodePosition.X);
    294296        if (CurrentChar = #13) then begin
    295           CodePosition.X := 1;
     297          CodePosition.X := 0;
    296298          Inc(CodePosition.Y);
    297299        end;
    … …  
    305307function TBaseParser.ReadCode: string;
    306308begin
    307   Result := FNextToken;
    308   GetNextToken;
    309   Log('Read: ' + Result);
     309  if TokenIndex < Tokens.Count then begin
     310    Result := TToken(Tokens[TokenIndex]).Token;
     311    Inc(TokenIndex);
     312  end else Result := '';
    310313end;
    311314
    312315function TBaseParser.NextToken: string;
    313316begin
    314   Result := FNextToken;
     317  if TokenIndex < Tokens.Count then begin
     318    Result := TToken(Tokens[TokenIndex]).Token;
     319  end else Result := '';
    315320end;
    316321
    317322function TBaseParser.NextTokenType: TTokenType;
    318323begin
    319   Result := FNextTokenType;
     324  if TokenIndex < Tokens.Count then begin
     325    Result := TToken(Tokens[TokenIndex]).TokenType;
     326  end else Result := ttEndOfFile;
    320327end;
    321328

  • branches/Transpascal/Compiler/Analyze/UPascalParser.pas

    r71 r72  
    4747
    4848
     49resourcestring
     50  SUnknownIdentifier = 'Unknown identificator "%s".';
     51  SIllegalExpression = 'Illegal expression "%s".';
     52  SRedefineIdentifier = 'Identificator "%s" redefinition.';
     53  STypeNotDefined = 'Type "%s" not defined.';
     54  SEndOfDataReached = 'Parser reached to end of input data.';
     55  SUndefinedVariable = 'Undefined variable "%s".';
     56  SUndefinedType = 'Undefined type "%s".';
     57  SUndefinedConstant = 'Undefined constant "%s".';
     58  SUnitNotFound = 'Unit "%s" not found.';
     59
     60
    4961implementation
    5062
    … …  
    6375    if Assigned(OnGetSource) then begin
    6476      if FOnGetSource(Name, Parser.SourceCodeText) then begin
    65         Parser.Init;
     77        Parser.Process;
    6678        Parser.FileName := Name;
    6779        Parser.OnErrorMessage := OnErrorMessage;
    … …  
    192204              end;
    193205            end else begin
    194               ErrorMessage(SUnknownIdentifier, [Identifier]);
     206              ErrorMessage(SUnknownIdentifier, [Identifier], -1);
    195207            end;
    196208          end;
    … …  
    326338      begin
    327339        Result := nil;
    328         ErrorMessage(SUnknownIdentifier, [ReadCode]);
     340        ErrorMessage(SUnknownIdentifier, [ReadCode], -1);
    329341      end;
    330342    end
    … …  
    334346    begin
    335347      Result := nil;
    336       ErrorMessage(SIllegalExpression, [ReadCode]);
     348      ErrorMessage(SIllegalExpression, [ReadCode], -1);
    337349    end;
    338350  end;
    … …  
    454466        ParseFunctionList(Functions, True)
    455467      else begin
    456         ErrorMessage(SUnknownIdentifier, [NextToken]);
     468        ErrorMessage(SUnknownIdentifier, [NextToken], -1);
    457469        ReadCode;
    458470      end;
    … …  
    529541                end;
    530542              end else
    531                 ErrorMessage(SRedefineIdentifier, [VariableName]);
     543                ErrorMessage(SRedefineIdentifier, [VariableName], 0);
    532544              Expect(':');
    533545              TypeName := ReadCode;
    534546              NewValueType := Parent.Types.Search(TypeName);
    535547              if not Assigned(NewValueType) then
    536                 ErrorMessage(STypeNotDefined, [TypeName])
     548                ErrorMessage(STypeNotDefined, [TypeName], -1)
    537549              else
    538550                for I := 0 to Identifiers.Count - 1 do
    … …  
    554566          NewValueType := Parent.Types.Search(TypeName);
    555567          if not Assigned(NewValueType) then
    556             ErrorMessage(STypeNotDefined, [TypeName])
     568            ErrorMessage(STypeNotDefined, [TypeName], -1)
    557569          else
    558570          begin
    … …  
    611623    ControlVariable := SourceCode.CommonBlock.Variables.Search(VariableName);
    612624    if not Assigned(ControlVariable) then
    613       ErrorMessage(SUndefinedVariable, [VariableName]);
     625      ErrorMessage(SUndefinedVariable, [VariableName], 0);
    614626    Expect(':=');
    615627    Start.CommonBlock := CommonBlock;
    … …  
    653665      end
    654666      else
    655         ErrorMessage(SRedefineIdentifier, [VariableName]);
     667        ErrorMessage(SRedefineIdentifier, [VariableName], 0);
    656668      Expect(':');
    657669      TypeName := ReadCode;
    658670      NewValueType := Parent.Types.Search(TypeName);
    659671      if NewValueType = nil then
    660         ErrorMessage(STypeNotDefined, [TypeName])
     672        ErrorMessage(STypeNotDefined, [TypeName], -1)
    661673      else
    662674        for I := 0 to Identifiers.Count - 1 do
    … …  
    714726      end
    715727      else
    716         ErrorMessage(SRedefineIdentifier, [ConstantName]);
     728        ErrorMessage(SRedefineIdentifier, [ConstantName], 0);
    717729      Expect(':');
    718730      TypeName := ReadCode;
    … …  
    723735
    724736      if NewValueType = nil then
    725         ErrorMessage(STypeNotDefined, [TypeName])
     737        ErrorMessage(STypeNotDefined, [TypeName], -1)
    726738      else
    727739        for I := 0 to Identifiers.Count - 1 do
    … …  
    800812        TTypeArray(Result).IndexType := ParseType(TypeList, False);
    801813        if not Assigned(TTypeArray(Result).IndexType) then
    802           ErrorMessage(SUndefinedType, [TypeName]);
     814          ErrorMessage(SUndefinedType, [TypeName], 0);
    803815        Expect(']');
    804816      end;
    … …  
    807819      TTypeArray(Result).ItemType := ParseType(TypeList, False);
    808820      if not Assigned(TTypeArray(Result).ItemType) then
    809         ErrorMessage(SUndefinedType, [TypeName]);
     821        ErrorMessage(SUndefinedType, [TypeName], 0);
    810822    end else
    811823    if NextToken = '^' then begin
    … …  
    834846        TType(Result).UsedType := TypeList.Search(TypeName);
    835847        if not Assigned(TType(Result).UsedType) then
    836           ErrorMessage(SUndefinedType, [TypeName]);
     848          ErrorMessage(SUndefinedType, [TypeName], 0);
    837849      end else begin
    838850        TType(Result) := TypeList.Search(TypeName);
    839851        if not Assigned(TType(Result)) then
    840           ErrorMessage(SUndefinedType, [TypeName]);
     852          ErrorMessage(SUndefinedType, [TypeName], 0);
    841853      end;
    842854    end;
    … …  
    922934constructor TPascalParser.Create;
    923935begin
     936  inherited;
    924937end;
    925938
    … …  
    949962        Exported := AExported;
    950963      end else begin
    951         ErrorMessage(SUnitNotFound, [Name]);
     964        ErrorMessage(SUnitNotFound, [Name], -2);
    952965        SourceCode.Delete(SourceCode.Count - 1);
    953966      end;
    … …  
    966979      if not Assigned(Module) then begin
    967980        if not ParseFile(Name) then begin
    968           ErrorMessage(SUnitNotFound, [Name]);
     981          ErrorMessage(SUnitNotFound, [Name], -2);
    969982          SourceCode.Delete(SourceCode.Count - 1);
    970983        end;

  • branches/Transpascal/Compiler/TranspascalCompiler.lpk

    r70 r72  
    1515      </Other>
    1616    </CompilerOptions>
    17     <Files Count="9">
     17    <Files Count="10">
    1818      <Item1>
    1919        <Filename Value="UCompiler.pas"/>
    … …  
    5252        <UnitName Value="UPascalParser"/>
    5353      </Item9>
     54      <Item10>
     55        <Filename Value="Analyze\UGrammer.pas"/>
     56        <UnitName Value="UGrammer"/>
     57      </Item10>
    5458    </Files>
    5559    <Type Value="RunAndDesignTime"/>

  • branches/Transpascal/Compiler/TranspascalCompiler.pas

    r70 r72  
    99uses
    1010    UCompiler, USourceCode, UProducerTreeView, UProducer, UProducerAsm8051,
    11   UProducerC, UProducerPascal, UParser, UPascalParser, LazarusPackageIntf;
     11  UProducerC, UProducerPascal, UParser, UPascalParser, UGrammer,
     12  LazarusPackageIntf;
    1213
    1314implementation

  • branches/Transpascal/Compiler/UCompiler.pas

    r71 r72  
    6565    Parser.FileName := ModuleName;
    6666    Parser.SourceCodeText := Source;
    67     Parser.Init;
     67    Parser.Process;
    6868    //ShowMessage(IntToHex(Integer(Addr(Parser.OnGetSource)), 8));
    6969    NewModule := Parser.ParseModule(ProgramCode);
Note: See TracChangeset for help on using the changeset viewer.