Ignore:
Timestamp:
Aug 9, 2010, 10:22:30 AM (14 years ago)
Author:
george
Message:

Reworked tokenizer code with state machine instead of direct sequence analyze.
Parser classes with class methods rewrited back to single class TPaascalParser which inherit from TBasePascal.

File:
1 edited

Legend:

Unmodified
Added
Removed

  • branches/DelphiToC/Analyze/UPascalParser.pas

    r43 r44  
    1212  EEndOfData = class(Exception);
    1313
    14   TPascalParser = class;
     14  TBaseParser = class;
    1515
    1616  TOnErrorMessage = procedure (Text: string) of object;
    1717
    18   { TParserWhileDo }
    19 
    20   TParserWhileDo = class
    21     class procedure Parse(Parser: TPascalParser; SourceCode: TWhileDo);
    22   end;
    23 
    24   { TParserExpression }
    25 
    26   TParserExpression = class
    27     class function Parse(Parser: TPascalParser; SourceCode: TExpression): TExpression;
    28   end;
    29 
    30   { TParserUsedModuleList }
    31 
    32   TParserUsedModuleList = class
    33     class procedure Parse(Parser: TPascalParser; SourceCode: TUsedModuleList);
    34   end;
    35 
    36   { TParserModule }
    37 
    38   TParserModule = class
    39     class procedure Parse(Parser: TPascalParser; SourceCode: TModule);
    40     class procedure ParseUnit(Parser: TPascalParser; SourceCode: TModule);
    41     class procedure ParseProgram(Parser: TPascalParser; SourceCode: TModule);
    42   end;
    43 
    44   TParserProgram = class
    45     class procedure Parse(Parser: TPascalParser; SourceCode: TProgram);
    46   end;
    47 
    48   { TParserCommonBlock }
    49 
    50   TParserCommonBlock = class
    51     class procedure Parse(Parser: TPascalParser; SourceCode: TCommonBlock; EndSymbol: Char = ';');
    52     class function ParseCommand(Parser: TPascalParser; SourceCode: TCommonBlock): TCommand;
    53   end;
    54 
    55   { TParserBeginEnd }
    56 
    57   TParserBeginEnd = class
    58     class procedure Parse(Parser: TPascalParser; SourceCode: TBeginEnd);
    59   end;
    60 
    61   TParserFunctionList = class
    62     class procedure Parse(Parser: TPascalParser; SourceCode: TFunctionList);
    63   end;
    64 
    65   TParserIfThenElse = class
    66     class procedure Parse(Parser: TPascalParser; SourceCode: TIfThenElse);
    67   end;
    68 
    69   TParserVariableList = class
    70     class procedure Parse(Parser: TPascalParser; SourceCode: TVariableList);
    71   end;
    72 
    73   TParserVariable = class
    74     class procedure Parse(Parser: TPascalParser; SourceCode: TVariable);
    75   end;
    76 
    77   TParserConstantList = class
    78     class procedure Parse(Parser: TPascalParser; SourceCode: TConstantList);
    79   end;
    80 
    81   TParserTypeList = class
    82     class procedure Parse(Parser: TPascalParser; SourceCode: TTypeList);
    83   end;
    84 
    85   TParserType = class
    86     class procedure Parse(Parser: TPascalParser; SourceCode: TType);
    87   end;
    88 
    89   TPascalParser = class
     18  TTokenType = (ttNone, ttIdentifier, ttConstantNumber, ttConstantString,
     19    ttOperator, ttEndOfFile, ttLineComment, ttBlockComment1, ttBlockComment2,
     20    ttUnknown, ttWhiteSpace);
     21
     22  { TBaseParser }
     23
     24  TBaseParser = class
    9025  private
    9126    ProgramCode: TProgram;
    9227    FOnErrorMessage: TOnErrorMessage;
     28    FNextToken: string;
     29    FNextTokenType: TTokenType;
     30    PreviousChar: Char;
     31    CurrentChar: Char;
    9332    procedure ErrorMessage(const Text: string; const Arguments: array of const);
    9433  public
    95     CodePosition: Integer;
     34    CodeStreamPosition: Integer;
     35    CodePosition: TPoint;
    9636    SourceCodeText: TStringList;
    9737    function IsAlphanumeric(Character: Char): Boolean;
    98     function NextCode(Shift: Boolean = False): string;
     38    procedure GetNextToken;
    9939    function ReadCode: string;
    10040    procedure Expect(Code: string);
    … …  
    10646    procedure Log(Text: string);
    10747    property OnErrorMessage: TOnErrorMessage read FOnErrorMessage write FOnErrorMessage;
    108   end;
     48    procedure Init;
     49  end;
     50
     51  { TPascalParser }
     52
     53  TPascalParser = class(TBaseParser)
     54    procedure ParseWhileDo(SourceCode: TWhileDo);
     55    function ParseExpression(SourceCode: TExpression): TExpression;
     56    procedure ParseUsedModuleList(SourceCode: TUsedModuleList);
     57    procedure ParseModule(SourceCode: TModule);
     58    procedure ParseUnit(SourceCode: TModule);
     59    procedure ParseProgram(SourceCode: TModule);
     60    procedure ParseAll(SourceCode: TProgram);
     61    procedure ParseCommonBlock(SourceCode: TCommonBlock; EndSymbol: Char = ';');
     62    function ParseCommand(SourceCode: TCommonBlock): TCommand;
     63    procedure ParseBeginEnd(SourceCode: TBeginEnd);
     64    procedure ParseFunctionList(SourceCode: TFunctionList);
     65    procedure ParseIfThenElse(SourceCode: TIfThenElse);
     66    procedure ParseVariableList(SourceCode: TVariableList);
     67    procedure ParseVariable(SourceCode: TVariable);
     68    procedure ParseConstantList(SourceCode: TConstantList);
     69    procedure ParseTypeList(SourceCode: TTypeList);
     70    procedure ParseType(SourceCode: TType);
     71  private
     72  end;
     73
    10974
    11075implementation
    … …  
    11984
    12085
    121 { TPascalParser }
    122 
    123 procedure TPascalParser.ErrorMessage(const Text: string; const Arguments: array of const);
     86{ TBaseParser }
     87
     88procedure TBaseParser.ErrorMessage(const Text: string; const Arguments: array of const);
    12489begin
    12590  if Assigned(FOnErrorMessage) then
    … …  
    12792end;
    12893
    129 procedure TPascalParser.Expect(Code: string);
    130 begin
    131   Log('Expected: ' + Code + '  Readed: ' + NextCode);
    132   if NextCode <> Code then begin
    133     ErrorMessage(SExpectedButFound, [Code, NextCode]);
     94procedure TBaseParser.Expect(Code: string);
     95begin
     96  Log('Expected: ' + Code + '  Readed: ' + FNextToken);
     97  if FNextToken <> Code then begin
     98    ErrorMessage(SExpectedButFound, [Code, FNextToken]);
    13499
    135100    // Recovery: try to find nearest same code
    136     while NextCode <> Code do
    137       ReadCode;
    138   end;
    139   ReadCode;
    140 end;
    141 
    142 function TPascalParser.IsAlphabetic(Character: Char): Boolean;
     101    while FNextToken <> Code do
     102      GetNextToken;
     103  end;
     104  GetNextToken;
     105end;
     106
     107function TBaseParser.IsAlphabetic(Character: Char): Boolean;
    143108begin
    144109  Result := (Character in ['a'..'z']) or (Character in ['A'..'Z']);
    145110end;
    146111
    147 function TPascalParser.IsAlphanumeric(Character: Char): Boolean;
     112function TBaseParser.IsAlphanumeric(Character: Char): Boolean;
    148113begin
    149114  Result := IsAlphabetic(Character) or (Character in ['0'..'9']);
    150115end;
    151116
    152 function TPascalParser.IsKeyword(Text: string): Boolean;
     117function TBaseParser.IsKeyword(Text: string): Boolean;
    153118var
    154119  I: Integer;
    … …  
    160125end;
    161126
    162 function TPascalParser.IsOperator(Text: string): Boolean;
     127function TBaseParser.IsOperator(Text: string): Boolean;
    163128var
    164129  I: Integer;
    … …  
    170135end;
    171136
    172 function TPascalParser.IsIdentificator(Text: string): Boolean;
     137function TBaseParser.IsIdentificator(Text: string): Boolean;
    173138var
    174139  I: Integer;
    … …  
    185150end;
    186151
    187 function TPascalParser.IsWhiteSpace(Character: Char): Boolean;
     152function TBaseParser.IsWhiteSpace(Character: Char): Boolean;
    188153begin
    189154  Result := (Character = ' ') or (Character = #13) or (Character = #10);
    190155end;
    191156
    192 procedure TPascalParser.Log(Text: string);
     157procedure TBaseParser.Log(Text: string);
    193158const
    194159  LogFileName = 'ParseLog.txt';
    … …  
    209174end;
    210175
    211 function TPascalParser.NextCode(Shift: Boolean = False): string;
     176procedure TBaseParser.Init;
     177begin
     178  CurrentChar := #0;
     179  PreviousChar := #0;
     180  FNextToken := '';
     181  FNextTokenType := ttNone;
     182  CodeStreamPosition := 1;
     183  GetNextToken;
     184end;
     185
     186procedure TBaseParser.GetNextToken;
    212187var
    213188  I: Integer;
    … …  
    219194  DoubleSpecChar : array[0..6] of string = (':=', '..', '<=', '>=', '<>', '+=', '-=');
    220195begin
    221   Result := '';
    222   J := CodePosition;
    223   I := CodePosition;
    224   with SourceCodeText do
    225   while Result = '' do begin
    226     while IsWhiteSpace(Text[I]) and (I < Length(Text)) do Inc(I);
    227     if I = Length(Text) then
    228       raise EEndOfData.Create(SEndOfDataReached);
    229     J := I;
    230     if Copy(Text, J, 2) = '//' then begin
    231       // Line comment
    232       while (Text[I] <> #13) and (Text[I] <> #10) do Inc(I);
    233       Result := '';
    234     end else
    235     if Copy(Text, J, 1) = '{' then begin
    236       // Block comment 1
    237       while (Text[I] <> '}') do Inc(I);
    238       Result := '';
    239     end else
    240     if Copy(Text, J, 2) = '(*' then begin
    241       // Block comment 2
    242       while not((Text[I] = '*') and (Text[I + 1] = ')')) do Inc(I);
    243       Result := '';
    244     end else
    245     if Text[J] = '''' then begin
    246       // String constant
    247       I := J + 1;
    248       while not ((Text[I] = '''') and (Text[I + 1] <> '''')) do Inc(I);
    249       Inc(I);
    250       Result := Copy(Text, J, I - J);
    251     end else
    252     if (Text[J] in SpecChar) then begin
    253       // Special char token
    254       if (Text[J + 1] in SpecChar) then begin
    255         for II := 0 to High(DoubleSpecChar) do
    256           if Copy(Text, J, 2) = DoubleSpecChar[II] then begin
    257             Result := Copy(Text, J, 2);
    258             Inc(J, 2);
    259             Break;
    260           end;
    261         I := J;
     196    FNextToken := '';
     197    FNextTokenType := ttNone;
     198    with SourceCodeText do
     199    while True do begin
     200      if CodeStreamPosition < Length(Text) then begin
     201        CurrentChar := Text[CodeStreamPosition];
     202      end else begin
     203        FNextToken := '';
     204        FNextTokenType := ttEndOfFile;
     205        Break;
    262206      end;
    263       if Result = '' then begin
    264         Result := Text[J];
    265         Inc(I);
     207      if FNextTokenType = ttNone then begin
     208        if IsWhiteSpace(CurrentChar) then FNextTokenType := ttWhiteSpace
     209        else
     210        if CurrentChar = '{' then begin
     211          FNextTokenType := ttBlockComment1;
     212        end else
     213        if CurrentChar = '''' then begin
     214          FNextTokenType := ttConstantString;
     215        end else
     216        if CurrentChar in SpecChar then begin
     217          FNextTokenType := ttOperator;
     218          FNextToken := FNextToken + CurrentChar;
     219        end else
     220        if IsAlphanumeric(CurrentChar) then begin
     221          FNextTokenType := ttIdentifier;
     222          FNextToken := FNextToken + CurrentChar;
     223        end else FNextTokenType := ttUnknown;
     224      end else
     225      if FNextTokenType = ttLineComment then begin
     226        if (CurrentChar = #13) or (CurrentChar = #10) then
     227          FNextTokenType := ttNone;
     228      end else
     229      if FNextTokenType = ttBlockComment1 then begin
     230        if (CurrentChar = '}') then
     231          FNextTokenType := ttNone;
     232      end else
     233      if FNextTokenType = ttBlockComment2 then begin
     234        if (PreviousChar = '*') and (CurrentChar = ')') then
     235          FNextTokenType := ttNone;
     236      end else
     237      if FNextTokenType = ttConstantString then begin
     238        if (CurrentChar = '''') and (PreviousChar = '''') then
     239          Break else
     240          FNextToken := FNextToken + CurrentChar;
     241      end else
     242      if FNextTokenType = ttOperator then begin
     243        if (CurrentChar = '*') and (PreviousChar = '(') then begin
     244          FNextToken := '';
     245          FNextTokenType := ttBlockComment2;
     246        end else
     247        if (CurrentChar = '/') and (PreviousChar = '/') then begin
     248          FNextToken := '';
     249          FNextTokenType := ttLineComment;
     250        end else
     251        if not (CurrentChar in SpecChar) then
     252          Break else begin
     253            J := 0;
     254            while (J < Length(DoubleSpecChar)) and ((PreviousChar + CurrentChar) <> DoubleSpecChar[J]) do Inc(J);
     255            if J < Length(DoubleSpecChar) then
     256              FNextToken := FNextToken + CurrentChar else Break;
     257          end;
     258      end else
     259      if FNextTokenType = ttIdentifier then begin
     260        if not IsAlphanumeric(CurrentChar) then
     261          Break else
     262          FNextToken := FNextToken + CurrentChar;
     263      end
     264      else if FNextTokenType = ttWhiteSpace then
     265        FNextTokenType := ttNone;
     266
     267      if FNextTokenType <> ttNone then begin
     268        Inc(CodeStreamPosition);
     269        PreviousChar := CurrentChar;
    266270      end;
    267     end else begin
    268       if IsAlphabetic(Text[I]) then begin
    269         // Identifier
    270         while IsAlphanumeric(Text[I]) do Inc(I);
    271         Result := Copy(Text, J, I - J);
    272       end else begin
    273         while not IsWhiteSpace(Text[I]) do Inc(I);
    274         Result := Copy(Text, J, I - J);
    275       end;
    276     end;
    277     J := I;
    278   end;
    279   if Shift then CodePosition := J;
    280 end;
    281 
    282 function TPascalParser.ReadCode: string;
    283 begin
    284   Result := NextCode(True);
     271    end;
     272end;
     273
     274function TBaseParser.ReadCode: string;
     275begin
     276  Result := FNextToken;
     277  GetNextToken;
    285278  Log('Read: ' + Result);
    286279end;
    … …  
    288281{ TParserWhileDo }
    289282
    290 class procedure TParserWhileDo.Parse(Parser: TPascalParser; SourceCode: TWhileDo);
    291 begin
    292   with Parser, SourceCode do begin
     283procedure TPascalParser.ParseWhileDo(SourceCode: TWhileDo);
     284begin
     285  with SourceCode do begin
    293286    Expect('while');
    294287    Condition.CommonBlock := CommonBlock;
    295     TParserExpression.Parse(Parser, Condition);
     288    ParseExpression(Condition);
    296289    Expect('do');
    297     Command := TParserCommonBlock.ParseCommand(Parser, CommonBlock);
     290    Command := ParseCommand(CommonBlock);
    298291  end;
    299292end;
    … …  
    301294{ TExpression }
    302295
    303 class function TParserExpression.Parse(Parser: TPascalParser;
    304   SourceCode: TExpression): TExpression;
     296function TPascalParser.ParseExpression(SourceCode: TExpression): TExpression;
    305297var
    306298  Identifier: string;
    … …  
    316308  Expressions := TExpressionList.Create;
    317309  Expressions.Add(TExpression.Create);
    318   with Parser, SourceCode do begin
    319     while ((NextCode <> ';') and (NextCode <> ',') and (not IsKeyWord(NextCode))) and
    320       not (((NextCode = ')') or (NextCode = ']'))) do begin
     310  with SourceCode do begin
     311    while ((FNextToken <> ';') and (FNextToken <> ',') and (not IsKeyWord(FNextToken))) and
     312      not (((FNextToken = ')') or (FNextToken = ']'))) do begin
    321313        Identifier := ReadCode;
    322314        if Identifier = '(' then begin
    … …  
    324316          with TExpression(Expressions.Last) do begin
    325317            SubItems[1] := TExpression.Create;
    326             TParserExpression.Parse(Parser, TExpression(SubItems[1]));
     318            ParseExpression(TExpression(SubItems[1]));
    327319          end;
    328320          with TExpression(Expressions.Items[Expressions.Add(TExpression.Create)]) do begin
    … …  
    357349              with TExpression(Expressions.Last) do begin
    358350                SubItems[1] := TExpression.Create;
    359                 if NextCode  = '(' then               // Method with parameters
     351                if FNextToken  = '(' then               // Method with parameters
    360352                with TExpression(SubItems[1]) do begin
    361353                  Expect('(');
    362354                  NewExpression := TExpression.Create;
    363355                  NewExpression.CommonBlock := CommonBlock;
    364                   TParserExpression.Parse(Parser, NewExpression);
     356                  ParseExpression(NewExpression);
    365357                  SubItems.Add(NewExpression);
    366                   while NextCode = ',' do begin
     358                  while FNextToken = ',' do begin
    367359                    Expect(',');
    368360                    NewExpression := TExpression.Create;
    369361                    NewExpression.CommonBlock := CommonBlock;
    370                     TParserExpression.Parse(Parser, NewExpression);
     362                    ParseExpression(NewExpression);
    371363                    SubItems.Add(NewExpression);
    372364                  end;
    … …  
    444436end;
    445437
    446 class function TParserCommonBlock.ParseCommand(Parser: TPascalParser; SourceCode: TCommonBlock): TCommand;
     438function TPascalParser.ParseCommand(SourceCode: TCommonBlock): TCommand;
    447439var
    448440  Identifier: string;
    … …  
    455447  IdentName: string;
    456448begin
    457   with Parser do begin
    458     if NextCode = 'begin' then begin
     449  begin
     450    if FNextToken = 'begin' then begin
    459451      Result := TBeginEnd.Create;
    460452      TBeginEnd(Result).CommonBlock := SourceCode;
    461453      //ShowMessage(IntToStr(Integer(SourceCode))
    462454      // + ' ' + IntToStr(Integer(Result)));
    463       TParserBeginEnd.Parse(Parser, TBeginEnd(Result));
     455      ParseBeginEnd(TBeginEnd(Result));
    464456    end else
    465     if NextCode = 'if' then begin
     457    if FNextToken = 'if' then begin
    466458      Result := TIfThenElse.Create;
    467459      TIfThenElse(Result).CommonBlock := SourceCode;
    468       TParserIfThenElse.Parse(Parser, TIfThenElse(Result));
     460      ParseIfThenElse(TIfThenElse(Result));
    469461    end else
    470     if NextCode = 'while' then begin
     462    if FNextToken = 'while' then begin
    471463      Result := TWhileDo.Create;
    472464      TWhileDo(Result).CommonBlock := SourceCode;
    473       TParserWhileDo.Parse(Parser, TWhileDo(Result));
     465      ParseWhileDo(TWhileDo(Result));
    474466    end else
    475     if IsIdentificator(NextCode) then begin
    476       if Assigned(SourceCode.Variables.Search(NextCode)) then begin
     467    if IsIdentificator(FNextToken) then begin
     468      if Assigned(SourceCode.Variables.Search(FNextToken)) then begin
    477469        Result := TAssignment.Create;
    478470        TAssignment(Result).CommonBlock := SourceCode;
    … …  
    482474        TAssignment(Result).Source := TExpression.Create;
    483475        TAssignment(Result).Source.CommonBlock := SourceCode;
    484         TParserExpression.Parse(Parser, TAssignment(Result).Source);
     476        ParseExpression(TAssignment(Result).Source);
    485477      end else
    486       if Assigned(SourceCode.Methods.Search(NextCode)) then begin
     478      if Assigned(SourceCode.Methods.Search(FNextToken)) then begin
    487479        Result := TMethodCall.Create;
    488480        TMethodCall(Result).CommonBlock := SourceCode;
    489         TMethodCall(Result).Method := SourceCode.Methods.Search(NextCode);
     481        TMethodCall(Result).Method := SourceCode.Methods.Search(FNextToken);
    490482        ReadCode;
    491483  //      ParseMetVariable(TMethodCall(Result).Target);
    … …  
    503495{ TParserModule }
    504496
    505 class procedure TParserModule.Parse(Parser: TPascalParser; SourceCode: TModule);
    506 begin
    507   with Parser do begin
    508     if NextCode = 'program' then
    509       ParseProgram(Parser, SourceCode)
    510     else if NextCode = 'unit' then
    511       ParseUnit(Parser, SourceCode)
    512     else ParseProgram(Parser, SourceCode);
    513   end;
    514 end;
    515 
    516 class procedure TParserModule.ParseProgram(Parser: TPascalParser; SourceCode: TModule);
     497procedure TPascalParser.ParseModule(SourceCode: TModule);
     498begin
     499  if FNextToken = 'program' then
     500    ParseProgram(SourceCode)
     501  else if FNextToken = 'unit' then
     502    ParseUnit(SourceCode)
     503  else ParseProgram(SourceCode);
     504end;
     505
     506procedure TPascalParser.ParseProgram(SourceCode: TModule);
    517507var
    518508  Identifier: string;
    519509begin
    520   with Parser, SourceCode do begin
    521     if NextCode = 'program' then begin
     510  with SourceCode do begin
     511    if FNextToken = 'program' then begin
    522512      Expect('program');
    523513      Name := ReadCode;
    … …  
    527517
    528518    // Uses section
    529     if NextCode = 'uses' then
    530       TParserUsedModuleList.Parse(Parser, UsedModules);
    531 
    532     TParserCommonBlock.Parse(Parser, SourceCode, '.');
    533   end;
    534 end;
    535 
    536 class procedure TParserModule.ParseUnit(Parser: TPascalParser; SourceCode: TModule);
    537 begin
    538   with Parser do begin
    539     Expect('unit');
    540     with TModule(ProgramCode.Modules[0]) do begin
    541       Name := ReadCode;
    542       ModuleType := mdUnit;
    543     end;
    544     Expect(';');
    545     //ParseInterface;
    546     //ParseImplementation;
    547   end;
     519    if FNextToken = 'uses' then
     520      ParseUsedModuleList(UsedModules);
     521
     522    ParseCommonBlock(SourceCode, '.');
     523  end;
     524end;
     525
     526procedure TPascalParser.ParseUnit(SourceCode: TModule);
     527begin
     528  Expect('unit');
     529  with TModule(ProgramCode.Modules[0]) do begin
     530    Name := ReadCode;
     531    ModuleType := mdUnit;
     532  end;
     533  Expect(';');
     534  //ParseInterface;
     535  //ParseImplementation;
    548536end;
    549537
    550538{ TParserProgram }
    551539
    552 class procedure TParserProgram.Parse(Parser: TPascalParser; SourceCode: TProgram);
    553 var
    554   I: Integer;
    555 begin
    556   with Parser, SourceCode do begin
    557     Log('==== Parse start ====');
    558     Modules.Clear;
    559     with TModule(Modules[Modules.Add(TModule.Create)]) do begin
    560       Name := 'Main';
    561       with TType(Types[Types.Add(TType.Create)]) do begin
    562         Name := 'Void';
    563         Size := 0;
    564         UsedType := nil;
    565       end;
    566       with TType(Types[Types.Add(TType.Create)]) do begin
    567         Name := 'Byte';
    568         Size := 1;
    569         UsedType := nil;
    570       end;
    571       with TFunction(Methods[Methods.Add(TFunction.Create)]) do begin
    572         Name := 'Exit';
    573         ResultType := TType(TModule(Modules[0]).Types[0]);
    574       end;
    575       with TFunction(Methods[Methods.Add(TFunction.Create)]) do begin
    576         Name := 'WriteLn';
    577         ResultType := TType(TModule(Modules[0]).Types[0]);
    578       end;
    579     end;
    580     TParserModule.Parse(Parser, TModule(Modules[0]));
     540procedure TPascalParser.ParseAll(SourceCode: TProgram);
     541var
     542  I: Integer;
     543begin
     544  with SourceCode do begin
     545    ParseModule(TModule(Modules[0]));
    581546  end;
    582547end;
    … …  
    584549{ TParserCommonBlock }
    585550
    586 class procedure TParserCommonBlock.Parse(Parser: TPascalParser; SourceCode: TCommonBlock; EndSymbol: Char = ';');
    587 begin
    588   with Parser, SourceCode do begin
    589     while NextCode <> EndSymbol do begin
    590       if NextCode = 'var' then
    591         TParserVariableList.Parse(Parser, Variables)
    592       else if NextCode = 'const' then
    593         TParserConstantList.Parse(Parser, Constants)
    594       else if NextCode = 'type' then
    595         TParserTypeList.Parse(Parser, Types)
    596       else if NextCode = 'procedure' then
    597         TParserFunctionList.Parse(Parser, Methods)
     551procedure TPascalParser.ParseCommonBlock(SourceCode: TCommonBlock; EndSymbol: Char = ';');
     552begin
     553  with SourceCode do begin
     554    while FNextToken <> EndSymbol do begin
     555      if FNextToken = 'var' then
     556        ParseVariableList(Variables)
     557      else if FNextToken = 'const' then
     558        ParseConstantList(Constants)
     559      else if FNextToken = 'type' then
     560        ParseTypeList(Types)
     561      else if FNextToken = 'procedure' then
     562        ParseFunctionList(Methods)
    598563      else begin
    599         TParserBeginEnd.Parse(Parser, Code);
     564        ParseBeginEnd(Code);
    600565        Break;
    601566      end;
    … …  
    607572{ TParserBeginEnd }
    608573
    609 class procedure TParserBeginEnd.Parse(Parser: TPascalParser; SourceCode: TBeginEnd);
     574procedure TPascalParser.ParseBeginEnd(SourceCode: TBeginEnd);
    610575var
    611576  NewCommand: TCommand;
    612577begin
    613578  //ShowMessage(IntToStr(Integer(SourceCode)) + ' ' + IntToStr(Integer(SourceCode.CommonBlock)));
    614   with Parser, SourceCode do begin
     579  with SourceCode do begin
    615580    Expect('begin');
    616     while NextCode <> 'end' do begin
    617       NewCommand := TParserCommonBlock.ParseCommand(Parser, CommonBlock);
     581    while FNextToken <> 'end' do begin
     582      Commands.Add(nil);
     583      NewCommand := ParseCommand(CommonBlock);
    618584      if Assigned(NewCommand) then Commands.Add(NewCommand);
    619585      //ShowMessage(NextCode);
    620       if NextCode = ';' then ReadCode;
     586      if FNextToken = ';' then ReadCode;
    621587    end;
    622588    Expect('end');
    … …  
    626592{ TParserParseFunctionList }
    627593
    628 class procedure TParserFunctionList.Parse(Parser: TPascalParser; SourceCode: TFunctionList);
     594procedure TPascalParser.ParseFunctionList(SourceCode: TFunctionList);
    629595var
    630596  Identifiers: TStringList;
    … …  
    636602begin
    637603  Identifiers := TStringList.Create;
    638   with Parser, SourceCode do begin
     604  with SourceCode do begin
    639605    with TFunction(Items[Add(TFunction.Create)]) do begin
    640606      Parent := SourceCode.Parent;
    641607      Expect('procedure');
    642608      Name := ReadCode;
    643       if NextCode = '(' then begin
     609      if FNextToken = '(' then begin
    644610        Expect('(');
    645         while NextCode <> ')' do begin
     611        while FNextToken <> ')' do begin
    646612//    while IsIdentificator(NextCode) do begin
    647613          with TParameterList(Parameters) do begin
    … …  
    650616            if not Assigned(Variable) then begin
    651617              Identifiers.Add(VariableName);
    652               while NextCode = ',' do begin
     618              while FNextToken = ',' do begin
    653619                Expect(',');
    654620                Identifiers.Add(ReadCode);
    … …  
    670636    end;
    671637    Expect(';');
    672     TParserCommonBlock.Parse(Parser, TFunction(Items[Count - 1]));
     638    ParseCommonBlock(TFunction(Items[Count - 1]));
    673639  end;
    674640  Identifiers.Destroy;
    … …  
    677643{ TParserIfThenElse }
    678644
    679 class procedure TParserIfThenElse.Parse(Parser: TPascalParser; SourceCode: TIfThenElse);
    680 begin
    681   with Parser, Sourcecode do begin
     645procedure TPascalParser.ParseIfThenElse(SourceCode: TIfThenElse);
     646begin
     647  with Sourcecode do begin
    682648    Expect('if');
    683649    Condition.CommonBlock := CommonBlock;
    684     TParserExpression.Parse(Parser, Condition);
     650    ParseExpression(Condition);
    685651    Expect('then');
    686     Command := TParserCommonBlock.ParseCommand(Parser, CommonBlock);
    687     if NextCode = 'else' then begin
     652    Command := ParseCommand(CommonBlock);
     653    if FNextToken = 'else' then begin
    688654      Expect('else');
    689       ElseCommand := TParserCommonBlock.ParseCommand(Parser, CommonBlock);
     655      ElseCommand := ParseCommand(CommonBlock);
    690656    end;
    691657  end;
    … …  
    694660{ TParserVariableList }
    695661
    696 class procedure TParserVariableList.Parse(Parser: TPascalParser; SourceCode: TVariableList);
     662procedure TPascalParser.ParseVariableList(SourceCode: TVariableList);
    697663var
    698664  Identifiers: TStringList;
    … …  
    704670begin
    705671  Identifiers := TStringList.Create;
    706   with Parser, SourceCode do begin
     672  with SourceCode do begin
    707673    Expect('var');
    708     while IsIdentificator(NextCode) do begin
     674    while IsIdentificator(FNextToken) do begin
    709675      Identifiers.Clear;
    710676      VariableName := ReadCode;
    … …  
    712678      if not Assigned(Variable) then begin
    713679        Identifiers.Add(VariableName);
    714         while NextCode = ',' do begin
     680        while FNextToken = ',' do begin
    715681          Expect(',');
    716682          Identifiers.Add(ReadCode);
    … …  
    734700{ TParserVariable }
    735701
    736 class procedure TParserVariable.Parse(Parser: TPascalParser; SourceCode: TVariable);
    737 begin
    738   with Parser, SourceCode do begin
    739     Name := NextCode;
     702procedure TPascalParser.ParseVariable(SourceCode: TVariable);
     703begin
     704  with SourceCode do begin
     705    Name := FNextToken;
    740706    Expect(':=');
    741707
    … …  
    745711{ TParserConstantList }
    746712
    747 class procedure TParserConstantList.Parse(Parser: TPascalParser; SourceCode: TConstantList);
     713procedure TPascalParser.ParseConstantList(SourceCode: TConstantList);
    748714var
    749715  Identifiers: TStringList;
    … …  
    756722begin
    757723  Identifiers := TStringList.Create;
    758   with Parser, SourceCode do begin
     724  with SourceCode do begin
    759725    Expect('const');
    760     while IsIdentificator(NextCode) do begin
     726    while IsIdentificator(FNextToken) do begin
    761727      ConstantName := ReadCode;
    762728      Constant := Search(ConstantName);
    763729      if not Assigned(Constant) then begin
    764730        Identifiers.Add(ConstantName);
    765         while NextCode = ',' do begin
     731        while FNextToken = ',' do begin
    766732          Expect(',');
    767733          Identifiers.Add(ReadCode);
    … …  
    789755{ TParserTypeList }
    790756
    791 class procedure TParserTypeList.Parse(Parser: TPascalParser; SourceCode: TTypeList);
    792 begin
    793   with Parser, SourceCode do begin
     757procedure TPascalParser.ParseTypeList(SourceCode: TTypeList);
     758begin
     759  with SourceCode do begin
    794760    Expect('type');
    795     while IsIdentificator(NextCode) do
     761    while IsIdentificator(FNextToken) do
    796762      with TType(Items[Add(TType.Create)]) do begin
    797763        Parent := SourceCode;
    798         TParserType.Parse(Parser, TType(Items[Count - 1]));
     764        ParseType(TType(Items[Count - 1]));
    799765      end;
    800766  end;
    … …  
    803769{ TParserType }
    804770
    805 class procedure TParserType.Parse(Parser: TPascalParser; SourceCode: TType);
    806 begin
    807   with Parser, SourceCode do begin
    808     Name := NextCode;
     771procedure TPascalParser.ParseType(SourceCode: TType);
     772begin
     773  with SourceCode do begin
     774    Name := FNextToken;
    809775    Expect('=');
    810     UsedType := Parent.Search(NextCode);
     776    UsedType := Parent.Search(FNextToken);
    811777  end;
    812778end;
    … …  
    814780{ TParserUsedModuleList }
    815781
    816 class procedure TParserUsedModuleList.Parse(Parser: TPascalParser;
    817   SourceCode: TUsedModuleList);
     782procedure TPascalParser.ParseUsedModuleList(SourceCode: TUsedModuleList);
    818783var
    819784  NewUsedModule: TUsedModule;
    820785begin
    821   with Parser do begin
    822     Expect('uses');
     786  Expect('uses');
     787  with TUsedModule(SourceCode.Items[SourceCode.Add(TUsedModule.Create)]) do begin
     788    Name := ReadCode;
     789  end;
     790  while FNextToken = ',' do begin
     791    Expect(',');
    823792    with TUsedModule(SourceCode.Items[SourceCode.Add(TUsedModule.Create)]) do begin
    824793      Name := ReadCode;
    825794    end;
    826     while NextCode = ',' do begin
    827       Expect(',');
    828       with TUsedModule(SourceCode.Items[SourceCode.Add(TUsedModule.Create)]) do begin
    829         Name := ReadCode;
    830       end;
    831     end;
    832     Expect(';');
    833   end;
     795  end;
     796  Expect(';');
    834797end;
    835798
Note: See TracChangeset for help on using the changeset viewer.