Changeset 17 for trunk/Compiler


Ignore:
Timestamp:
Nov 8, 2010, 2:14:13 PM (14 years ago)
Author:
george
Message:
  • Modified: Enhanced Delphi producer.
Location:
trunk/Compiler
Files:
5 edited

Legend:

Unmodified
Added
Removed

  • trunk/Compiler/Analyze/UAnalyzerPascal.pas

    r12 r17  
    2727      Expressions: TListExpression; var Func: TFunctionCall): Boolean;
    2828    function ParseUses(SourceCode: TUsedModuleList; AExported: Boolean): Boolean;
     29    function ParseUsesItem(SourceCode: TUsedModuleList; AExported: Boolean): Boolean;
    2930    function ParseModule(ProgramCode: TProgram): TModule; override;
    3031    function ParseUnit(var SourceCode: TModuleUnit; ProgramCode: TProgram): Boolean;
    … …  
    12561257  if NextToken = 'uses' then begin
    12571258    Expect('uses');
     1259    ParseUsesItem(SourceCode, AExported);
     1260    while NextToken = ',' do begin
     1261      Expect(',');
     1262      ParseUsesItem(SourceCode, AExported);
     1263    end;
     1264    Expect(';');
     1265    Result := True;
     1266  end else Result := False;
     1267end;
     1268
     1269function TAnalyzerPascal.ParseUsesItem(SourceCode: TUsedModuleList;
     1270  AExported: Boolean): Boolean;
     1271begin
    12581272    with TUsedModule(SourceCode.Items[SourceCode.Add(TUsedModule.Create)]) do begin
    12591273      Name := ReadToken;
    … …  
    12731287      end;
    12741288    end;
    1275     while NextToken = ',' do begin
    1276       Expect(',');
    1277       with TUsedModule(SourceCode.Items[SourceCode.Add(TUsedModule.Create)]) do
    1278       begin
    1279         Name := ReadToken;
    1280         if NextToken = 'in' then begin
    1281           Expect('in');
    1282           Location := ReadToken;
    1283         end else Location := Name + '.pas';
    1284         Module := SourceCode.ParentModule.ParentProgram.Modules.Search(Name);
    1285         if not Assigned(Module) then begin
    1286           if not ParseFile(Name) then begin
    1287             ErrorMessage(SUnitNotFound, [Name], -2);
    1288             SourceCode.Delete(SourceCode.Count - 1);
    1289           end;
    1290         end;
    1291       end;
    1292     end;
    1293     Expect(';');
    1294     Result := True;
    1295   end else Result := False;
    12961289end;
    12971290

  • trunk/Compiler/Produce/UProducer.pas

    r12 r17  
    77
    88uses
    9   USourceCode, Classes, SysUtils;
     9  USourceCode, Classes, SysUtils, StrUtils;
    1010
    1111type
     12
     13  { TProducer }
     14
    1215  TProducer = class
    1316    Name: string;
     17    TextSource: TStringList;
     18    IndentationLength: Integer;
     19    Indetation: Integer;
     20    procedure Emit(AText: string);
     21    procedure EmitLn(AText: string = '');
    1422    procedure AssignToStringList(Target: TStringList); virtual; abstract;
    1523    procedure Produce(Module: TModule); virtual; abstract;
     24    constructor Create;
     25    destructor Destroy; override;
    1626  end;
    1727
    … …  
    4151{$I 'GenericObjectList.inc'}
    4252
     53{ TProducer }
     54
     55procedure TProducer.EmitLn(AText: string = '');
     56begin
     57  Emit(AText);
     58  TextSource.Add('');
     59end;
     60
     61constructor TProducer.Create;
     62begin
     63  TextSource := TStringList.Create;
     64  IndentationLength := 2;
     65end;
     66
     67destructor TProducer.Destroy;
     68begin
     69  TextSource.Free;
     70  inherited Destroy;
     71end;
     72
     73procedure TProducer.Emit(AText: string);
     74begin
     75  with TextSource do begin
     76    if Count = 0 then Add('');
     77    if Strings[Count - 1] = '' then
     78      Strings[Count - 1] := Strings[Count - 1] + DupeString(' ', IndentationLength * Indetation);
     79    Strings[Count - 1] := Strings[Count - 1] + AText;
     80  end;
     81end;
     82
    4383end.

  • trunk/Compiler/Produce/UProducerDynamicC.pas

    r12 r17  
    1717    function TranslateType(Name: string): string;
    1818    function TranslateOperator(Name: string): string;
    19     procedure Emit(AText: string);
    20     procedure EmitLn(AText: string = '');
    2119    procedure GenerateUses(UsedModules: TUsedModuleList);
    2220    procedure GenerateModule(Module: TModule);
    … …  
    3937    function GenerateExpression(Expression: TExpression): string;
    4038  public
    41     TextSource: TStringList;
    42     IndentationLength: Integer;
    43     Indetation: Integer;
    4439    procedure AssignToStringList(Target: TStringList); override;
    4540    procedure Produce(Module: TModule); override;
    … …  
    5449constructor TProducerDynamicC.Create;
    5550begin
    56   TextSource := TStringList.Create;
    57   IndentationLength := 2;
    5851  Name := 'Dynamic C';
    5952end;
    … …  
    9083  else if Name = 'xor' then Result := '^'
    9184  else Result := Name;
    92 end;
    93 
    94 procedure TProducerDynamicC.EmitLn(AText: string = '');
    95 begin
    96   Emit(AText);
    97   TextSource.Add('');
    98 end;
    99 
    100 procedure TProducerDynamicC.Emit(AText: string);
    101 begin
    102   with TextSource do begin
    103     if Count = 0 then Add('');
    104     if Strings[Count - 1] = '' then
    105       Strings[Count - 1] := Strings[Count - 1] + DupeString(' ', IndentationLength * Indetation);
    106     Strings[Count - 1] := Strings[Count - 1] + AText;
    107   end;
    10885end;
    10986

  • trunk/Compiler/Produce/UProducerPascal.pas

    r12 r17  
    1515  TProducerPascal = class(TProducer)
    1616  private
    17     procedure Emit(AText: string; NewLine: Boolean = True);
    1817    procedure GenerateUses(UsedModules: TUsedModuleList);
    1918    procedure GenerateModule(Module: TModule);
     19    procedure GenerateUnit(Module: TModule);
     20    procedure GenerateLibrary(Module: TModule);
     21    procedure GeneratePackage(Module: TModule);
    2022    procedure GenerateType(AType: TType; AssignSymbol: Char = ':');
    2123    procedure GenerateTypes(Types: TTypeList);
    2224    procedure GenerateCommonBlock(CommonBlock: TCommonBlock;
    2325      LabelPrefix: string);
    24     procedure GenerateProgram(ProgramBlock: TProgram);
    2526    procedure GenerateFunctions(Functions: TFunctionList);
    2627    procedure GenerateConstants(Constants: TConstantList);
    … …  
    3536    function GenerateExpression(Expression: TExpression): string;
    3637  public
    37     TextSource: TStringList;
    38     IndentationLength: Integer;
    39     Indetation: Integer;
    4038    procedure AssignToStringList(Target: TStringList); override;
    4139    procedure Produce(Module: TModule); override;
    … …  
    5048constructor TProducerPascal.Create;
    5149begin
    52   IndentationLength := 2;
    53   TextSource := TStringList.Create;
     50  inherited;
    5451  Name := 'Delphi';
    5552end;
    … …  
    5754destructor TProducerPascal.Destroy;
    5855begin
    59   TextSource.Free;
    6056  inherited;
    6157end;
    6258
    63 procedure TProducerPascal.Emit(AText: string; NewLine: Boolean = True);
    64 begin
    65   with TextSource do begin
    66     if Count = 0 then Add('');
    67     if Strings[Count - 1] = '' then
    68       Strings[Count - 1] := Strings[Count - 1] + DupeString(' ', IndentationLength * Indetation);
    69     Strings[Count - 1] := Strings[Count - 1] + AText;
    70     if NewLine then Add('');
    71   end;
    72 end;
    73 
    7459procedure TProducerPascal.GenerateUses(UsedModules: TUsedModuleList);
    7560var
    7661  I: Integer;
    77   Line: string;
    78 begin
    79   Line := 'uses ';
     62  ModuleName: string;
     63begin
     64  EmitLn('uses');
     65  Inc(Indetation);
    8066  for I := 0 to UsedModules.Count - 1 do begin
    81     Line := Line + TUsedModule(UsedModules[I]).Name;
    82     if I < UsedModules.Count - 1 then Line := Line + ', ';
    83   end;
    84   Emit(Line + ';');
    85   Emit('');
     67    if Assigned(TUsedModule(UsedModules[I]).Module) then
     68      ModuleName := TUsedModule(UsedModules[I]).Module.Name
     69      else ModuleName := '(' + TUsedModule(UsedModules[I]).Name + ')';
     70    if UsedModules.ParentModule is TModuleProgram then begin
     71      Emit(ModuleName + ' in ''' + ModuleName + '.pas''');
     72      if I < UsedModules.Count - 1 then EmitLn(', ');
     73    end else begin
     74      Emit(ModuleName);
     75      if I < UsedModules.Count - 1 then Emit(', ');
     76    end;
     77  end;
     78  EmitLn(';');
     79  Dec(Indetation);
    8680end;
    8781
    … …  
    9185  if Module is TModuleProgram then
    9286  with TModuleProgram(Module) do begin
    93     Emit('program', False);
    94     Emit(' ' + Name + ';');
    95     Emit('');
     87    Module.TargetFile := Module.Name + '.dpr';
     88    EmitLn('program ' + Name + ';');
    9689    GenerateUses(UsedModules);
    9790    GenerateCommonBlock(Body, '');
    98     Emit('.', False);
     91    EmitLn('.');
    9992  end else
    100   if Module is TModuleUnit then Emit('unit', False)
    101   else if Module is TModuleLibrary then Emit('library', False)
    102   else if Module is TModulePackage then Emit('package', False);
     93  if Module is TModuleUnit then GenerateUnit(Module)
     94  else if Module is TModuleLibrary then GenerateLibrary(Module)
     95  else if Module is TModulePackage then GeneratePackage(Module);
     96end;
     97
     98procedure TProducerPascal.GenerateUnit(Module: TModule);
     99begin
     100  EmitLn('unit ' + TModuleUnit(Module).Name + ';');
     101  EmitLn;
     102  EmitLn('interface');
     103  EmitLn;
     104  GenerateCommonBlock(TModuleUnit(Module).Body, '.');
     105  EmitLn('implementation');
     106  EmitLn;
     107  EmitLn('end.');
     108end;
     109
     110procedure TProducerPascal.GenerateLibrary(Module: TModule);
     111begin
     112
     113end;
     114
     115procedure TProducerPascal.GeneratePackage(Module: TModule);
     116begin
     117
    103118end;
    104119
    … …  
    108123begin
    109124  if AType is TTypeRecord then begin
    110     Emit(AType.Name + ' ' + AssignSymbol + ' record');
     125    EmitLn(AType.Name + ' ' + AssignSymbol + ' record');
    111126    Inc(Indetation);
    112127    for I := 0 to TTypeRecord(AType).CommonBlock.Types.Count - 1 do begin
    113128      GenerateType(TType(TTypeRecord(AType).CommonBlock.Types[I]));
    114       Emit(';');
     129      EmitLn(';');
    115130    end;
    116131    Dec(Indetation);
    117     Emit('end', False);
     132    Emit('end');
    118133  end else
    119134  if AType is TTypeArray then begin
    120     Emit(AType.Name + ' ' + AssignSymbol + ' array ', False);
     135    Emit(AType.Name + ' ' + AssignSymbol + ' array ');
    121136    if Assigned(TTypeArray(AType).IndexType) then begin
    122       Emit('[', False);
     137      Emit('[');
    123138      GenerateType(TTypeArray(AType).IndexType);
    124       Emit(']', False);
    125     end;
    126     Emit(' of ', False);
     139      Emit(']');
     140    end;
     141    Emit(' of ');
    127142    if Assigned(TTypeArray(AType).ItemType) then
    128143      GenerateType(TTypeArray(AType).ItemType);
    129144  end else begin
    130     Emit(AType.Name, False);
     145    Emit(AType.Name);
    131146    if Assigned(AType.UsedType) then begin
    132       Emit(' ' + AssignSymbol + ' ', False);
     147      Emit(' ' + AssignSymbol + ' ');
    133148      GenerateType(AType.UsedType);
    134149    end;
    … …  
    141156begin
    142157  if Types.Count > 0 then begin
    143     Emit('type');
     158    EmitLn('type');
    144159    Inc(Indetation);
    145160    for I := 0 to Types.Count - 1 do
    … …  
    147162    if (not Internal) then begin
    148163      GenerateType(TType(Types[I]), '=');
    149       Emit(';');
     164      EmitLn(';');
    150165    end;
    151166    Dec(Indetation);
    152     Emit('');
     167    EmitLn;
    153168  end;
    154169end;
    155170
    156171procedure TProducerPascal.Produce(Module: TModule);
     172var
     173  I: Integer;
    157174begin
    158175  inherited;
    159176  TextSource.Clear;
     177
     178  // Check unit names
     179  with Module.ParentProgram do
     180  for I := 0 to Modules.Count - 1 do
     181    if TModule(Modules[I]).Name = 'System' then
     182      TModule(Modules[I]).Name := 'System2';
     183
    160184  GenerateModule(Module);
    161 end;
    162 
    163 procedure TProducerPascal.GenerateProgram(ProgramBlock: TProgram);
    164 var
    165   I: Integer;
    166 begin
    167   Indetation := 0;;
    168   with ProgramBlock do
    169   for I := 0 to Modules.Count - 1 do
    170     GenerateModule(TModule(Modules[I]));
    171185end;
    172186
    … …  
    195209    if (FunctionType = ftFunction) and Assigned(ResultType) then
    196210      Line := Line + ': ' + ResultType.Name;
    197     Emit(Line + ';');
     211    EmitLn(Line + ';');
    198212    GenerateBeginEnd(Code);
    199     Emit(';');
    200     Emit('');
     213    EmitLn(';');
     214    EmitLn;
    201215  end;
    202216end;
    … …  
    207221begin
    208222  if Constants.Count > 0 then begin
    209     Emit('const');
     223    EmitLn('const');
    210224    Inc(Indetation);
    211225    for I := 0 to Constants.Count - 1 do
    212226    with TConstant(Constants[I]) do
    213227    if not System then begin
    214       Emit(Name + ': ' + ValueType.Name + ' = ' + Value + ';');
     228      //Emit(Name + ': ');
     229      //if Assigned(ValueType) then Emit(ValueType.Name);
     230      //Emit(' = ' + Value + ';');
    215231    end;
    216232    Dec(Indetation);
    … …  
    223239  I: Integer;
    224240begin
    225   Emit('begin');
     241  EmitLn('begin');
    226242  Inc(Indetation);
    227243  // Commands
    228244  for I := 0 to BeginEnd.Commands.Count - 1 do begin
    229245    GenerateCommand(TCommand(BeginEnd.Commands[I]));
    230     Emit(';');
     246    EmitLn(';');
    231247  end;
    232248
    233249  Dec(Indetation);
    234   Emit('end', False);
     250  Emit('end');
    235251end;
    236252
    … …  
    239255  I: Integer;
    240256begin
    241   Emit('var');
     257  EmitLn('var');
    242258  Inc(Indetation);
    243259  for I := 0 to Variables.Count - 1 do
    244260  with TVariable(Variables[I]) do
    245     Emit(Name + ': ' + ValueType.Name + ';');
     261    EmitLn(Name + ': ' + ValueType.Name + ';');
    246262  Dec(Indetation);
    247   Emit('');
     263  EmitLn;
    248264end;
    249265
    … …  
    286302procedure TProducerPascal.GenerateAssignment(Assignment: TAssignment);
    287303begin
    288   Emit(Assignment.Target.Name + ' := ' + GenerateExpression(Assignment.Source), False);
     304  Emit(Assignment.Target.Name + ' := ' + GenerateExpression(Assignment.Source));
    289305end;
    290306
    … …  
    305321    end;
    306322  end;
    307   Emit(Line, False);
     323  Emit(Line);
    308324end;
    309325

  • trunk/Compiler/TranspascalCompiler.lpk

    r14 r17  
    1212      </SearchPaths>
    1313      <Other>
    14         <CustomOptions Value="-dSINGLE_PRODUCER"/>
     14        <CustomOptions Value="-dSINGLE_PRODUCER_"/>
    1515        <CompilerPath Value="$(CompPath)"/>
    1616      </Other>
Note: See TracChangeset for help on using the changeset viewer.