Changeset 34


Ignore:
Timestamp:
Aug 4, 2010, 3:10:20 PM (14 years ago)
Author:
george
Message:
  • Upraveno: Metody pro rozkládání bloků rozděleny do samostatných tříd.
  • Upraveno: Seznamy typu TList přepsány na TObjectList.
Files:
1 added
3 edited

Legend:

Unmodified
Added
Removed

  • branches/DelphiToC

    • Property svn:ignore

      •  

        old new  
        55*.dcu
        66ProjectGroup1.bdsgroup
         7ParseLog.txt

  • branches/DelphiToC/Analyze/UPascalParser.pas

    r24 r34  
    2424  end;
    2525
    26 
     26  TParserModule = class(TModule)
     27    procedure Parse(Parser: TPascalParser);
     28    procedure ParseUnit(Parser: TPascalParser);
     29    procedure ParseProgram(Parser: TPascalParser);
     30  end;
     31
     32  TParserProgram = class(TProgram)
     33    procedure Parse(Parser: TPascalParser);
     34  end;
     35
     36  TParserCommonBlock = class(TCommonBlock)
     37    procedure Parse(Parser: TPascalParser; EndSymbol: Char = ';');
     38  end;
     39
     40  TParserBeginEnd = class(TBeginEnd)
     41    procedure Parse(Parser: TPascalParser; Command: TBeginEnd);
     42  end;
     43
     44  TParserParseFunction = class(TFunction)
     45    procedure Parse(Parser: TPascalParser; Command: TBeginEnd);
     46  end;
    2747
    2848  TPascalParser = class
    … …  
    4363    function IsKeyword(Text: string): Boolean;
    4464    function IsOperator(Text: string): Boolean;
    45     procedure ParseProgram(AProgram: TProgram);
    46     procedure ParseModule(Module: TModule);
    47     procedure ParseModuleUnit(Module: TModule);
    48     procedure ParseModuleProgram(Module: TModule);
    4965    procedure ParseFunction(FunctionList: TFunctionList);
    5066    procedure ParseFunctionParameterList(ParameterList: TParameterList);
    … …  
    5571    procedure ParseTypeList(TypeList: TTypeList);
    5672    procedure ParseType(AType: TType);
    57     procedure ParseCommonBlockDefinitions(CommonBlock: TCommonBlock; EndSymbol: string = ';');
    58     function ParseCommonBlockExpression(CommonBlock: TCommonBlock): TExpression;
     73    //function ParseCommonBlockExpression(CommonBlock: TCommonBlock): TExpression;
    5974    function ParseCommand(CommonBlock: TCommonBlock): TCommand;
    6075    procedure ParseBeginEnd(CommonBlock: TCommonBlock; Command: TBeginEnd);
    … …  
    204219end;
    205220
    206 procedure TPascalParser.ParseModuleUnit(Module: TModule);
    207 begin
    208   with Module do begin
    209     Expect('unit');
    210     with TModule(ProgramCode.Modules[0]) do begin
    211       Name := ReadCode;
    212       ModuleType := mdUnit;
    213     end;
    214     Expect(';');
    215     //ParseInterface;
    216     //ParseImplementation;
    217   end;
    218 end;
    219 
    220221function TPascalParser.ReadCode: string;
    221222begin
    … …  
    268269    end;
    269270    Expect(';');
    270     ParseCommonBlockDefinitions(TFunction(Items[Count - 1]));
     271    TParserCommonBlock(TFunction(Items[Count - 1])).Parse(Parser);
    271272  end;
    272273  Identifiers.Destroy;
    … …  
    285286  if NextCode = 'else' then begin
    286287    Expect('else');
    287   end;
    288 end;
    289 
    290 procedure TPascalParser.ParseProgram(AProgram: TProgram);
    291 var
    292   I: Integer;
    293 begin
    294   Log('==== Parse start ====');
    295   with AProgram do begin
    296     for I := 0 to Modules.Count - 1 do
    297       TModule(Modules[I]).Clear;
    298     Modules.Clear;
    299     with TModule(Modules[Modules.Add(TModule.Create)]) do begin
    300       Name := 'main';
    301       with TType(Types[Types.Add(TType.Create)]) do begin
    302         Name := 'void';
    303         Size := 0;
    304         UsedType := nil;
    305       end;
    306       with TType(Types[Types.Add(TType.Create)]) do begin
    307         Name := 'byte';
    308         Size := 1;
    309         UsedType := nil;
    310       end;
    311       with TFunction(Methods[Methods.Add(TFunction.Create)]) do begin
    312         Name := 'exit';
    313         ResultType := TModule(Modules[0]).Types[0];
    314       end;
    315     end;
    316     ParseModule(TModule(Modules[0]));
    317288  end;
    318289end;
    … …  
    365336end;
    366337
    367 procedure TPascalParser.ParseModuleProgram(Module: TModule);
    368 var
    369   Identifier: string;
    370 begin
    371   with Module do begin
    372     if NextCode = 'program' then begin
    373       Expect('program');
    374       Name := ReadCode;
    375       ModuleType := mdProgram;
    376       Expect(';');
    377     end else Name := '';
    378 
    379     // Uses section
    380     if NextCode = 'uses' then begin
    381       Identifier := ReadCode;
    382       while NextCode = ',' do begin
    383         Identifier := ReadCode;
    384 
    385       end;
    386     end;
    387     ParseCommonBlockDefinitions(Module, '.');
    388   end;
    389 end;
    390 
    391 procedure TPascalParser.ParseModule(Module: TModule);
    392 begin
    393   with Module do begin
    394     if NextCode = 'program' then ParseModuleProgram(Module)
    395     else if NextCode = 'unit' then ParseModuleUnit(Module)
    396     else ParseModuleProgram(Module);
    397   end;
    398 end;
    399 
    400 procedure TPascalParser.ParseBeginEnd(CommonBlock: TCommonBlock; Command: TBeginEnd);
    401 var
    402   NewCommand: TCommand;
    403 begin
    404   with Command do begin
    405     Expect('begin');
    406     while NextCode <> 'end' do begin
    407       NewCommand := ParseCommand(CommonBlock);
    408       if Assigned(NewCommand) then Commands.Add(NewCommand);
    409       //ShowMessage(NextCode);
    410       if NextCode = ';' then ReadCode;     
    411     end;
    412     Expect('end');
    413   end;
    414 end;
    415 
    416 procedure TPascalParser.ParseCommonBlockDefinitions(CommonBlock: TCommonBlock; EndSymbol: string = ';');
    417 begin
    418   with CommonBlock do begin
    419     while NextCode <> EndSymbol do begin
    420       if NextCode = 'var' then ParseVariableList(TVariableList(Variables))
    421       else if NextCode = 'const' then ParseConstantList(TConstantList(Constants))
    422       else if NextCode = 'type' then ParseTypeList(TTypeList(Types))
    423       else if NextCode = 'procedure' then ParseFunction(Methods)
    424       else begin
    425         ParseBeginEnd(CommonBlock, Code);
    426         Break;
    427       end;
    428     end;
    429     Expect(EndSymbol);
    430   end;
    431 end;
    432 
    433338function TPascalParser.ParseCommand(CommonBlock: TCommonBlock): TCommand;
    434339var
    … …  
    442347  IdentName: string;
    443348begin
    444   if NextCode = 'begin' then begin
     349 (* if NextCode = 'begin' then begin
    445350    Result := TBeginEnd.Create;
    446351    ParseBeginEnd(CommonBlock, TBeginEnd(Result));
    … …  
    688593  II: Integer;
    689594begin
    690   Expressions := TExpressionList.Create;
     595(*  Expressions := TExpressionList.Create;
    691596  Expressions.Add(TExpression.Create);
    692   with CommonBlock do begin
     597  with Parser do begin
    693598    while ((NextCode <> ';') and (NextCode <> ',') and (not IsKeyWord(NextCode))) and
    694599      not (((NextCode = ')') or (NextCode = ']'))) do begin
    … …  
    795700  TExpression(Expressions[1]).SubItems[0] := nil;
    796701  Expressions.Destroy;
     702  *)
     703end;
     704
     705{ TParserCommand }
     706
     707procedure TParserCommand.Parse(Parser: TPascalParser);
     708begin
     709
     710end;
     711
     712{ TParserModule }
     713
     714procedure TParserModule.Parse(Parser: TPascalParser);
     715begin
     716  with Parser do begin
     717    if NextCode = 'program' then ParseProgram(Parser)
     718    else if NextCode = 'unit' then ParseUnit(Parser)
     719    else ParseProgram(Parser);
     720  end;
     721end;
     722
     723procedure TParserModule.ParseProgram(Parser: TPascalParser);
     724var
     725  Identifier: string;
     726begin
     727  with Parser do begin
     728    if NextCode = 'program' then begin
     729      Expect('program');
     730      Name := ReadCode;
     731      ModuleType := mdProgram;
     732      Expect(';');
     733    end else Name := '';
     734
     735    // Uses section
     736    if NextCode = 'uses' then begin
     737      Identifier := ReadCode;
     738      while NextCode = ',' do begin
     739        Identifier := ReadCode;
     740
     741      end;
     742    end;
     743    TParserCommonBlock(Self).Parse(Parser, '.');
     744  end;
     745end;
     746
     747procedure TParserModule.ParseUnit(Parser: TPascalParser);
     748begin
     749  with Parser do begin
     750    Expect('unit');
     751    with TModule(ProgramCode.Modules[0]) do begin
     752      Name := ReadCode;
     753      ModuleType := mdUnit;
     754    end;
     755    Expect(';');
     756    //ParseInterface;
     757    //ParseImplementation;
     758  end;
     759end;
     760
     761{ TParserProgram }
     762
     763procedure TParserProgram.Parse(Parser: TPascalParser);
     764var
     765  I: Integer;
     766begin
     767  with Parser do begin
     768    Log('==== Parse start ====');
     769    Modules.Clear;
     770    with TModule(Modules[Modules.Add(TModule.Create)]) do begin
     771      Name := 'main';
     772      with TType(Types[Types.Add(TType.Create)]) do begin
     773        Name := 'void';
     774        Size := 0;
     775        UsedType := nil;
     776      end;
     777      with TType(Types[Types.Add(TType.Create)]) do begin
     778        Name := 'byte';
     779        Size := 1;
     780        UsedType := nil;
     781      end;
     782      with TFunction(Methods[Methods.Add(TFunction.Create)]) do begin
     783        Name := 'exit';
     784        ResultType := TType(TModule(Modules[0]).Types[0]);
     785      end;
     786    end;
     787    TParserModule(TModule(Modules[0])).Parse(Parser);
     788  end;
     789end;
     790
     791{ TParserCommonBlock }
     792
     793procedure TParserCommonBlock.Parse(Parser: TPascalParser; EndSymbol: Char = ';');
     794begin
     795  with Parser do begin
     796    while NextCode <> EndSymbol do begin
     797      if NextCode = 'var' then ParseVariableList(TVariableList(Variables))
     798      else if NextCode = 'const' then ParseConstantList(TConstantList(Constants))
     799      else if NextCode = 'type' then ParseTypeList(TTypeList(Types))
     800      else if NextCode = 'procedure' then ParseFunction(Methods)
     801      else begin
     802        ParseBeginEnd(CommonBlock, Code);
     803        Break;
     804      end;
     805    end;
     806    Expect(EndSymbol);
     807  end;
     808end;
     809
     810{ TParserBeginEnd }
     811
     812procedure TParserBeginEnd.Parse(Parser: TPascalParser; Command: TBeginEnd);
     813var
     814  NewCommand: TCommand;
     815begin
     816  with Parser do begin
     817    Expect('begin');
     818    while NextCode <> 'end' do begin
     819      NewCommand := ParseCommand(CommonBlock);
     820      if Assigned(NewCommand) then Commands.Add(NewCommand);
     821      //ShowMessage(NextCode);
     822      if NextCode = ';' then ReadCode;
     823    end;
     824    Expect('end');
     825  end;
    797826end;
    798827

  • branches/DelphiToC/UPascalSource.pas

    r20 r34  
    55uses
    66  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
    7   Dialogs, StdCtrls;
     7  Dialogs, StdCtrls, Contnrs;
    88
    99type
    … …  
    102102  TCaseOfEnd = class(TCommand)
    103103    Expression: TExpression;
    104     Branches: TList; // TList<TCaseOfEndBranche>
     104    Branches: TObjectList; // TObjectList<TCaseOfEndBranche>
    105105    ElseCommand: TCommand;
     106    constructor Create;
     107    destructor Destroy; override;
    106108  end;
    107109
    … …  
    116118  end;
    117119
    118   TCommandList = class(TList)
     120  TCommandList = class(TObjectList)
    119121
    120122  end;
    … …  
    146148
    147149  TTypeRecord = class
    148     Items: TList; // TList<TTypeRecordItem>
     150    Items: TObjectList; // TObjectList<TTypeRecordItem>
    149151  end;
    150152
    … …  
    154156  end;
    155157
    156   TTypeList = class(TList)
     158  TTypeList = class(TObjectList)
    157159    Parent: TCommonBlock;
    158160    function Search(Name: string): TType;
    … …  
    166168  end;
    167169
    168   TConstantList = class(TList)
     170  TConstantList = class(TObjectList)
    169171    Parent: TCommonBlock;
    170172    function Search(Name: string): TConstant;
    … …  
    178180  end;
    179181
    180   TVariableList = class(TList)
     182  TVariableList = class(TObjectList)
    181183    Parent: TCommonBlock;
    182184    function Search(Name: string): TVariable;
    … …  
    190192  end;
    191193
    192   TParameterList = class(TList)
     194  TParameterList = class(TObjectList)
    193195    Parent: TFunction;
    194196    function Search(Name: string): TParameter;
    … …  
    208210  end;
    209211
    210   TExpressionList = class(TList)
     212  TExpressionList = class(TObjectList)
    211213    destructor Destroy; override;
    212214  end;
    … …  
    221223  end;
    222224
    223   TOperationList = class(TList)
     225  TOperationList = class(TObjectList)
    224226    destructor Destroy; override;
    225227  end;
    … …  
    227229  TFunction = class(TCommonBlock)
    228230  public
    229     Parameters: TList; // TList<TVariable>
     231    Parameters: TObjectList; // TObjectList<TVariable>
    230232    ResultType: TType;
    231233    constructor Create; override;
    … …  
    233235  end;
    234236
    235   TFunctionList = class(TList)
     237  TFunctionList = class(TObjectList)
    236238    Parent: TCommonBlock;
    237239    function Search(Name: string): TFunction;
    … …  
    242244  public
    243245    ModuleType: TModuleType;
    244     UsedModules: TList; // TList<TModule>
     246    UsedModules: TObjectList; // TObjectList<TModule>
    245247    constructor Create; override;
    246248    procedure Clear;
    … …  
    250252  TProgram = class
    251253    Device: TDevice;
    252     Modules: TList; // TList<TModule>
     254    Modules: TObjectList; // TObjectList<TModule>
    253255    constructor Create;
    254256    destructor Destroy; override;
    … …  
    290292begin
    291293  Device := TDevice.Create;
    292   Modules := TList.Create;
     294  Modules := TObjectList.Create;
    293295end;
    294296
    295297destructor TProgram.Destroy;
    296 var
    297   I: Integer;
    298 begin
    299   for I := 0 to Modules.Count - 1 do
    300     TModule(Modules[I]).Free;
     298begin
    301299  Modules.Free;
    302300  Device.Free;
    … …  
    323321  I := 0;
    324322  while (I < Count) and (TConstant(Items[I]).Name <> Name) do Inc(I);
    325   if I < Count then Result := Items[I] else begin
     323  if I < Count then Result := TConstant(Items[I]) else begin
    326324    if Assigned(Parent.Parent) then Result := Parent.Parent.Constants.Search(Name)
    327325      else begin
    … …  
    344342begin
    345343  inherited;
    346   UsedModules := TList.Create;
     344  UsedModules := TObjectList.Create;
    347345end;
    348346
    … …  
    406404  I := 0;
    407405  while (I < Count) and (TType(Items[I]).Name <> Name) do Inc(I);
    408   if I < Count then Result := Items[I] else begin
     406  if I < Count then Result := TType(Items[I]) else begin
    409407    if Assigned(Parent.Parent) then Result := Parent.Parent.Types.Search(Name)
    410408      else begin
    … …  
    417415
    418416destructor TVariableList.Destroy;
    419 var
    420   I: Integer;
    421 begin
    422   for I := 0 to Count - 1 do
    423     TVariable(Items[I]).Free;
     417begin
    424418  inherited;
    425419end;
    … …  
    431425  I := 0;
    432426  while (I < Count) and (TVariable(Items[I]).Name <> Name) do Inc(I);
    433   if I < Count then Result := Items[I] else begin
     427  if I < Count then Result := TVariable(Items[I]) else begin
    434428    if Assigned(Parent.Parent) then Result := Parent.Parent.Variables.Search(Name)
    435429      else begin
    … …  
    461455  I := 0;
    462456  while (I < Count) and (TFunction(Items[I]).Name <> Name) do Inc(I);
    463   if I < Count then Result := Items[I] else begin
     457  if I < Count then Result := TFunction(Items[I]) else begin
    464458    if Assigned(Parent.Parent) then Result := Parent.Parent.Methods.Search(Name)
    465459      else begin
    … …  
    530524  I := 0;
    531525  while (I < Count) and (TParameter(Items[I]).Name <> Name) do Inc(I);
    532   if I < Count then Result := Items[I] else Result := nil;
     526  if I < Count then Result := TParameter(Items[I])
     527    else Result := nil;
    533528end;
    534529
    … …  
    579574end;
    580575
     576{ TCaseOfEnd }
     577
     578constructor TCaseOfEnd.Create;
     579begin
     580  Branches := TObjectList.Create
     581end;
     582
     583destructor TCaseOfEnd.Destroy;
     584begin
     585  Branches.Destroy;
     586  inherited;
     587end;
     588
    581589end.
    582590
Note: See TracChangeset for help on using the changeset viewer.