Ignore:
Timestamp:
Aug 5, 2010, 11:32:36 AM (14 years ago)
Author:
george
Message:

Parser classes inheriting pascal source tree classes rewrited using class methods and source tree as parametr. This solve problem "class x not related to y.".

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/DelphiToC/Analyze/UPascalParser.pas

    r39 r40  
    1414  TOnErrorMessage = procedure (Text: string) of object;
    1515
    16   TParserWhileDo = class(TWhileDo)
    17     procedure Parse(Parser: TPascalParser);
    18   end;
    19 
    20   TParserExpression = class(TExpression)
    21     function Parse(Parser: TPascalParser): TExpression;
    22   end;
    23 
    24   TParserModule = class(TModule)
    25     procedure Parse(Parser: TPascalParser);
    26     procedure ParseUnit(Parser: TPascalParser);
    27     procedure ParseProgram(Parser: TPascalParser);
    28   end;
    29 
    30   TParserProgram = class(TProgram)
    31     procedure Parse(Parser: TPascalParser);
    32   end;
    33 
    34   TParserCommonBlock = class(TCommonBlock)
    35     procedure Parse(Parser: TPascalParser; EndSymbol: Char = ';');
    36     function ParseCommand(Parser: TPascalParser): TCommand;
    37   end;
    38 
    39   TParserBeginEnd = class(TBeginEnd)
    40     procedure Parse(Parser: TPascalParser);
    41   end;
    42 
    43   TParserFunctionList = class(TFunctionList)
    44     procedure Parse(Parser: TPascalParser);
    45   end;
    46 
    47   TParserIfThenElse = class(TIfThenElse)
    48     procedure Parse(Parser: TPascalParser);
    49   end;
    50 
    51   TParserVariableList = class(TVariableList)
    52     procedure Parse(Parser: TPascalParser);
    53   end;
    54 
    55   TParserVariable = class(TVariable)
    56     procedure Parse(Parser: TPascalParser);
    57   end;
    58 
    59   TParserConstantList = class(TConstantList)
    60     procedure Parse(Parser: TPascalParser);
    61   end;
    62 
    63   TParserTypeList = class(TTypeList)
    64     procedure Parse(Parser: TPascalParser);
    65   end;
    66 
    67   TParserType = class(TType)
    68     procedure Parse(Parser: TPascalParser);
     16  { TParserWhileDo }
     17
     18  TParserWhileDo = class
     19    class procedure Parse(Parser: TPascalParser; SourceCode: TWhileDo);
     20  end;
     21
     22  { TParserExpression }
     23
     24  TParserExpression = class
     25    class function Parse(Parser: TPascalParser; SourceCode: TExpression): TExpression;
     26  end;
     27
     28  { TParserModule }
     29
     30  TParserModule = class
     31    class procedure Parse(Parser: TPascalParser; SourceCode: TModule);
     32    class procedure ParseUnit(Parser: TPascalParser; SourceCode: TModule);
     33    class procedure ParseProgram(Parser: TPascalParser; SourceCode: TModule);
     34  end;
     35
     36  TParserProgram = class
     37    class procedure Parse(Parser: TPascalParser; SourceCode: TProgram);
     38  end;
     39
     40  { TParserCommonBlock }
     41
     42  TParserCommonBlock = class
     43    class procedure Parse(Parser: TPascalParser; SourceCode: TCommonBlock; EndSymbol: Char = ';');
     44    class function ParseCommand(Parser: TPascalParser; SourceCode: TCommonBlock): TCommand;
     45  end;
     46
     47  { TParserBeginEnd }
     48
     49  TParserBeginEnd = class
     50    class procedure Parse(Parser: TPascalParser; SourceCode: TBeginEnd);
     51  end;
     52
     53  TParserFunctionList = class
     54    class procedure Parse(Parser: TPascalParser; SourceCode: TFunctionList);
     55  end;
     56
     57  TParserIfThenElse = class
     58    class procedure Parse(Parser: TPascalParser; SourceCode: TIfThenElse);
     59  end;
     60
     61  TParserVariableList = class
     62    class procedure Parse(Parser: TPascalParser; SourceCode: TVariableList);
     63  end;
     64
     65  TParserVariable = class
     66    class procedure Parse(Parser: TPascalParser; SourceCode: TVariable);
     67  end;
     68
     69  TParserConstantList = class
     70    class procedure Parse(Parser: TPascalParser; SourceCode: TConstantList);
     71  end;
     72
     73  TParserTypeList = class
     74    class procedure Parse(Parser: TPascalParser; SourceCode: TTypeList);
     75  end;
     76
     77  TParserType = class
     78    class procedure Parse(Parser: TPascalParser; SourceCode: TType);
    6979  end;
    7080
     
    7686  public
    7787    CodePosition: Integer;
    78     SourceCode: TStringList;
     88    SourceCodeText: TStringList;
    7989    function IsAlphanumeric(Character: Char): Boolean;
    8090    function NextCode(Shift: Boolean = False): string;
     
    197207  J := CodePosition;
    198208  I := CodePosition;
    199   with SourceCode do
     209  with SourceCodeText do
    200210  while Result = '' do begin
    201211    while IsWhiteSpace(Text[I]) do Inc(I);
     
    250260{ TParserWhileDo }
    251261
    252 procedure TParserWhileDo.Parse(Parser: TPascalParser);
    253 begin
    254   with Parser do begin
     262class procedure TParserWhileDo.Parse(Parser: TPascalParser; SourceCode: TWhileDo);
     263begin
     264  with Parser, SourceCode do begin
    255265    Expect('while');
    256266    Condition.CommonBlock := CommonBlock;
    257     TParserExpression(Condition).Parse(Parser);
     267    TParserExpression.Parse(Parser, Condition);
    258268    Expect('do');
    259     Command := TParserCommonBlock(CommonBlock).ParseCommand(Parser);
     269    Command := TParserCommonBlock.ParseCommand(Parser, CommonBlock);
    260270  end;
    261271end;
     
    263273{ TExpression }
    264274
    265 function TParserExpression.Parse(Parser: TPascalParser): TExpression;
     275class function TParserExpression.Parse(Parser: TPascalParser;
     276  SourceCode: TExpression): TExpression;
    266277var
    267278  Identifier: string;
     
    277288  Expressions := TExpressionList.Create;
    278289  Expressions.Add(TExpression.Create);
    279   with Parser do begin
     290  with Parser, SourceCode do begin
    280291    while ((NextCode <> ';') and (NextCode <> ',') and (not IsKeyWord(NextCode))) and
    281292      not (((NextCode = ')') or (NextCode = ']'))) do begin
     
    285296          with TExpression(Expressions.Last) do begin
    286297            SubItems[1] := TExpression.Create;
    287             TParserExpression(SubItems[1]).Parse(Parser);
     298            TParserExpression.Parse(Parser, TExpression(SubItems[1]));
    288299          end;
    289300          with TExpression(Expressions.Items[Expressions.Add(TExpression.Create)]) do begin
    290             CommonBlock := Self.CommonBlock;
     301            CommonBlock := SourceCode.CommonBlock;
    291302            SubItems[0] := TExpression(Expressions[Expressions.Count - 2]).SubItems[1];
    292303          end;
     
    309320            end;
    310321            with TExpression(Expressions.Items[Expressions.Add(TExpression.Create)]) do begin
    311               CommonBlock := Self.CommonBlock;
     322              CommonBlock := SourceCode.CommonBlock;
    312323              SubItems[0] := TExpression(Expressions[Expressions.Count - 2]).SubItems[1];
    313324            end;
     
    323334                  NewExpression := TExpression.Create;
    324335                  NewExpression.CommonBlock := CommonBlock;
    325                   TParserExpression(NewExpression).Parse(Parser);
     336                  TParserExpression.Parse(Parser, NewExpression);
    326337                  SubItems.Add(NewExpression);
    327338                  while NextCode = ',' do begin
     
    329340                    NewExpression := TExpression.Create;
    330341                    NewExpression.CommonBlock := CommonBlock;
    331                     TParserExpression(NewExpression).Parse(Parser);
     342                    TParserExpression.Parse(Parser, NewExpression);
    332343                    SubItems.Add(NewExpression);
    333344                  end;
     
    338349              end;
    339350              with TExpression(Expressions.Items[Expressions.Add(TExpression.Create)]) do begin
    340                 CommonBlock := Self.CommonBlock;
     351                CommonBlock := SourceCode.CommonBlock;
    341352                SubItems[0] := TExpression(Expressions[Expressions.Count - 2]).SubItems[1];
    342353              end;
     
    351362                end;
    352363                with TExpression(Expressions.Items[Expressions.Add(TExpression.Create)]) do begin
    353                   CommonBlock := Self.CommonBlock;
     364                  CommonBlock := SourceCode.CommonBlock;
    354365                  SubItems[0] := TExpression(Expressions[Expressions.Count - 2]).SubItems[1];
    355366                end;
     
    364375          with TExpression(Expressions.Last) do begin
    365376            SubItems[1] := TExpression.Create;
    366             TExpression(SubItems[1]).CommonBlock := Self.CommonBlock;
     377            TExpression(SubItems[1]).CommonBlock := SourceCode.CommonBlock;
    367378            TExpression(SubItems[1]).NodeType := ntConstant;
    368379
     
    378389          //ShowMessage(IntToStr(Expressions.Count));
    379390          with TExpression(Expressions.Items[Expressions.Add(TExpression.Create)]) do begin
    380             CommonBlock := Self.CommonBlock;
     391            CommonBlock := SourceCode.CommonBlock;
    381392            SubItems[0] := TExpression(Expressions[Expressions.Count - 2]).SubItems[1];
    382393          end;
     
    397408      end;
    398409    end;
    399   end;
    400   Assign(TExpression(TExpression(Expressions.First).SubItems[1]));
    401   TExpression(Expressions.First).SubItems[1] := nil;
    402   //ShowMessage(IntToStr(Expressions.Count));
    403   TExpression(Expressions[1]).SubItems[0] := nil;
    404   Expressions.Destroy;
    405 end;
    406 
    407 function TParserCommonBlock.ParseCommand(Parser: TPascalParser): TCommand;
     410    Assign(TExpression(TExpression(Expressions.First).SubItems[1]));
     411    TExpression(Expressions.First).SubItems[1] := nil;
     412    //ShowMessage(IntToStr(Expressions.Count));
     413    TExpression(Expressions[1]).SubItems[0] := nil;
     414    Expressions.Destroy;
     415  end;
     416end;
     417
     418class function TParserCommonBlock.ParseCommand(Parser: TPascalParser; SourceCode: TCommonBlock): TCommand;
    408419var
    409420  Identifier: string;
     
    419430    if NextCode = 'begin' then begin
    420431      Result := TBeginEnd.Create;
    421       Result.CommonBlock := Self;
    422       TParserBeginEnd(Result).Parse(Parser);
     432      Result.CommonBlock := SourceCode;
     433      TParserBeginEnd.Parse(Parser, TBeginEnd(Result));
    423434    end else
    424435    if NextCode = 'if' then begin
    425436      Result := TIfThenElse.Create;
    426       Result.CommonBlock := Self;
    427       TParserIfThenElse(Result).Parse(Parser);
     437      Result.CommonBlock := SourceCode;
     438      TParserIfThenElse.Parse(Parser, TIfThenElse(Result));
    428439    end else
    429440    if NextCode = 'while' then begin
    430441      Result := TWhileDo.Create;
    431       Result.CommonBlock := Self;
    432       TParserWhileDo(Result).Parse(Parser);
     442      Result.CommonBlock := SourceCode;
     443      TParserWhileDo.Parse(Parser, TWhileDo(Result));
    433444    end else
    434445    if IsIdentificator(NextCode) then begin
    435       if Assigned(Variables.Search(NextCode)) then begin
     446      if Assigned(SourceCode.Variables.Search(NextCode)) then begin
    436447        Result := TAssignment.Create;
    437         Result.CommonBlock := Self;
     448        Result.CommonBlock := SourceCode;
    438449        IdentName := ReadCode;
    439         TAssignment(Result).Target := Variables.Search(IdentName);
     450        TAssignment(Result).Target := SourceCode.Variables.Search(IdentName);
    440451        Expect(':=');
    441452        TAssignment(Result).Source := TExpression.Create;
    442         TAssignment(Result).Source.CommonBlock := Self;
    443         TParserExpression(TAssignment(Result).Source).Parse(Parser);
     453        TAssignment(Result).Source.CommonBlock := SourceCode;
     454        TParserExpression.Parse(Parser, TAssignment(Result).Source);
    444455      end else
    445       if Assigned(Methods.Search(NextCode)) then begin
     456      if Assigned(SourceCode.Methods.Search(NextCode)) then begin
    446457        Result := TMethodCall.Create;
    447         Result.CommonBlock := Self;
     458        Result.CommonBlock := SourceCode;
    448459  //      ParseMetVariable(TMethodCall(Result).Target);
    449460      end;
     
    577588{ TParserModule }
    578589
    579 procedure TParserModule.Parse(Parser: TPascalParser);
     590class procedure TParserModule.Parse(Parser: TPascalParser; SourceCode: TModule);
    580591begin
    581592  with Parser do begin
    582593    if NextCode = 'program' then
    583       ParseProgram(Parser)
     594      ParseProgram(Parser, SourceCode)
    584595    else if NextCode = 'unit' then
    585       ParseUnit(Parser)
    586     else ParseProgram(Parser);
    587   end;
    588 end;
    589 
    590 procedure TParserModule.ParseProgram(Parser: TPascalParser);
     596      ParseUnit(Parser, SourceCode)
     597    else ParseProgram(Parser, SourceCode);
     598  end;
     599end;
     600
     601class procedure TParserModule.ParseProgram(Parser: TPascalParser; SourceCode: TModule);
    591602var
    592603  Identifier: string;
    593604begin
    594   with Parser do begin
     605  with Parser, SourceCode do begin
    595606    if NextCode = 'program' then begin
    596607      Expect('program');
     
    608619      end;
    609620    end;
    610     TParserCommonBlock(Self).Parse(Parser, '.');
    611   end;
    612 end;
    613 
    614 procedure TParserModule.ParseUnit(Parser: TPascalParser);
     621    TParserCommonBlock.Parse(Parser, SourceCode, '.');
     622  end;
     623end;
     624
     625class procedure TParserModule.ParseUnit(Parser: TPascalParser; SourceCode: TModule);
    615626begin
    616627  with Parser do begin
     
    628639{ TParserProgram }
    629640
    630 procedure TParserProgram.Parse(Parser: TPascalParser);
     641class procedure TParserProgram.Parse(Parser: TPascalParser; SourceCode: TProgram);
    631642var
    632643  I: Integer;
    633644begin
    634   with Parser do begin
     645  with Parser, SourceCode do begin
    635646    Log('==== Parse start ====');
    636647    Modules.Clear;
     
    652663      end;
    653664    end;
    654     TParserModule(TModule(Modules[0])).Parse(Parser);
     665    TParserModule.Parse(Parser, TModule(Modules[0]));
    655666  end;
    656667end;
     
    658669{ TParserCommonBlock }
    659670
    660 procedure TParserCommonBlock.Parse(Parser: TPascalParser; EndSymbol: Char = ';');
    661 begin
    662   with Parser do begin
     671class procedure TParserCommonBlock.Parse(Parser: TPascalParser; SourceCode: TCommonBlock; EndSymbol: Char = ';');
     672begin
     673  with Parser, SourceCode do begin
    663674    while NextCode <> EndSymbol do begin
    664675      if NextCode = 'var' then
    665         TParserVariableList(Variables).Parse(Parser)
     676        TParserVariableList.Parse(Parser, Variables)
    666677      else if NextCode = 'const' then
    667         TParserConstantList(Constants).Parse(Parser)
     678        TParserConstantList.Parse(Parser, Constants)
    668679      else if NextCode = 'type' then
    669         TParserTypeList(Types).Parse(Parser)
     680        TParserTypeList.Parse(Parser, Types)
    670681      else if NextCode = 'procedure' then
    671         TParserFunctionList(Methods).Parse(Parser)
     682        TParserFunctionList.Parse(Parser, Methods)
    672683      else begin
    673         TParserBeginEnd(Code).Parse(Parser);
     684        TParserBeginEnd.Parse(Parser, Code);
    674685        Break;
    675686      end;
     
    681692{ TParserBeginEnd }
    682693
    683 procedure TParserBeginEnd.Parse(Parser: TPascalParser);
     694class procedure TParserBeginEnd.Parse(Parser: TPascalParser; SourceCode: TBeginEnd);
    684695var
    685696  NewCommand: TCommand;
    686697begin
    687   with Parser do begin
     698  with Parser, SourceCode do begin
    688699    Expect('begin');
    689700    while NextCode <> 'end' do begin
    690       NewCommand := TParserCommonBlock(CommonBlock).ParseCommand(Parser);
     701      NewCommand := TParserCommonBlock.ParseCommand(Parser, CommonBlock);
    691702      if Assigned(NewCommand) then Commands.Add(NewCommand);
    692703      //ShowMessage(NextCode);
     
    699710{ TParserParseFunctionList }
    700711
    701 procedure TParserFunctionList.Parse(Parser: TPascalParser);
     712class procedure TParserFunctionList.Parse(Parser: TPascalParser; SourceCode: TFunctionList);
    702713var
    703714  Identifiers: TStringList;
     
    709720begin
    710721  Identifiers := TStringList.Create;
    711   with Parser do begin
     722  with Parser, SourceCode do begin
    712723    with TFunction(Items[Add(TFunction.Create)]) do begin
    713       Parent := Self.Parent;
     724      Parent := SourceCode.Parent;
    714725      Expect('procedure');
    715726      Name := ReadCode;
     
    743754    end;
    744755    Expect(';');
    745     TParserCommonBlock(TFunction(Items[Count - 1])).Parse(Parser);
     756    TParserCommonBlock.Parse(Parser, TFunction(Items[Count - 1]));
    746757  end;
    747758  Identifiers.Destroy;
     
    750761{ TParserIfThenElse }
    751762
    752 procedure TParserIfThenElse.Parse(Parser: TPascalParser);
     763class procedure TParserIfThenElse.Parse(Parser: TPascalParser; SourceCode: TIfThenElse);
    753764begin
    754765  with Parser do begin
     
    763774{ TParserVariableList }
    764775
    765 procedure TParserVariableList.Parse(Parser: TPascalParser);
     776class procedure TParserVariableList.Parse(Parser: TPascalParser; SourceCode: TVariableList);
    766777var
    767778  Identifiers: TStringList;
     
    773784begin
    774785  Identifiers := TStringList.Create;
    775   with Parser do begin
     786  with Parser, SourceCode do begin
    776787    Expect('var');
    777788    while IsIdentificator(NextCode) do begin
     
    802813{ TParserVariable }
    803814
    804 procedure TParserVariable.Parse(Parser: TPascalParser);
    805 begin
    806   with Parser do begin
     815class procedure TParserVariable.Parse(Parser: TPascalParser; SourceCode: TVariable);
     816begin
     817  with Parser, SourceCode do begin
    807818    Name := NextCode;
    808819    Expect(':=');
     
    813824{ TParserConstantList }
    814825
    815 procedure TParserConstantList.Parse(Parser: TPascalParser);
     826class procedure TParserConstantList.Parse(Parser: TPascalParser; SourceCode: TConstantList);
    816827var
    817828  Identifiers: TStringList;
     
    824835begin
    825836  Identifiers := TStringList.Create;
    826   with Parser do begin
     837  with Parser, SourceCode do begin
    827838    Expect('const');
    828839    while IsIdentificator(NextCode) do begin
     
    857868{ TParserTypeList }
    858869
    859 procedure TParserTypeList.Parse(Parser: TPascalParser);
    860 begin
    861   with Parser do begin
     870class procedure TParserTypeList.Parse(Parser: TPascalParser; SourceCode: TTypeList);
     871begin
     872  with Parser, SourceCode do begin
    862873    Expect('type');
    863874    while IsIdentificator(NextCode) do
    864875      with TType(Items[Add(TType.Create)]) do begin
    865         Parent := Self;
    866         TParserType(Items[Count - 1]).Parse(Parser);
     876        Parent := SourceCode;
     877        TParserType.Parse(Parser, TType(Items[Count - 1]));
    867878      end;
    868879  end;
     
    871882{ TParserType }
    872883
    873 procedure TParserType.Parse(Parser: TPascalParser);
    874 begin
    875   with Parser do begin
     884class procedure TParserType.Parse(Parser: TPascalParser; SourceCode: TType);
     885begin
     886  with Parser, SourceCode do begin
    876887    Name := NextCode;
    877888    Expect('=');
Note: See TracChangeset for help on using the changeset viewer.