Changeset 17 for trunk/Compiler/Produce/UProducerPascal.pas

Timestamp:

Nov 8, 2010, 2:14:13 PM (14 years ago)

Author:

george

Message:

• Modified: Enhanced Delphi producer.

File:

• trunk/Compiler/Produce/UProducerPascal.pas (modified) (14 diffs)

trunk/Compiler/Produce/UProducerPascal.pas

@@ -15 +15 @@
   TProducerPascal = class(TProducer)
   private
-    procedure Emit(AText: string; NewLine: Boolean = True);
     procedure GenerateUses(UsedModules: TUsedModuleList);
     procedure GenerateModule(Module: TModule);
+    procedure GenerateUnit(Module: TModule);
+    procedure GenerateLibrary(Module: TModule);
+    procedure GeneratePackage(Module: TModule);
     procedure GenerateType(AType: TType; AssignSymbol: Char = ':');
     procedure GenerateTypes(Types: TTypeList);
     procedure GenerateCommonBlock(CommonBlock: TCommonBlock;
       LabelPrefix: string);
-    procedure GenerateProgram(ProgramBlock: TProgram);
     procedure GenerateFunctions(Functions: TFunctionList);
     procedure GenerateConstants(Constants: TConstantList);
@@ -35 +36 @@
     function GenerateExpression(Expression: TExpression): string;
   public
-    TextSource: TStringList;
-    IndentationLength: Integer;
-    Indetation: Integer;
     procedure AssignToStringList(Target: TStringList); override;
     procedure Produce(Module: TModule); override;
@@ -50 +48 @@
 constructor TProducerPascal.Create;
 begin
-  IndentationLength := 2;
-  TextSource := TStringList.Create;
+  inherited;
   Name := 'Delphi';
 end;
@@ -57 +54 @@
 destructor TProducerPascal.Destroy;
 begin
-  TextSource.Free;
   inherited;
 end;
 
-procedure TProducerPascal.Emit(AText: string; NewLine: Boolean = True);
-begin
-  with TextSource do begin
-    if Count = 0 then Add('');
-    if Strings[Count - 1] = '' then
-      Strings[Count - 1] := Strings[Count - 1] + DupeString(' ', IndentationLength * Indetation);
-    Strings[Count - 1] := Strings[Count - 1] + AText;
-    if NewLine then Add('');
-  end;
-end;
-
 procedure TProducerPascal.GenerateUses(UsedModules: TUsedModuleList);
 var
   I: Integer;
-  Line: string;
-begin
-  Line := 'uses ';
+  ModuleName: string;
+begin
+  EmitLn('uses');
+  Inc(Indetation);
   for I := 0 to UsedModules.Count - 1 do begin
-    Line := Line + TUsedModule(UsedModules[I]).Name;
-    if I < UsedModules.Count - 1 then Line := Line + ', ';
-  end;
-  Emit(Line + ';');
-  Emit('');
+    if Assigned(TUsedModule(UsedModules[I]).Module) then
+      ModuleName := TUsedModule(UsedModules[I]).Module.Name
+      else ModuleName := '(' + TUsedModule(UsedModules[I]).Name + ')';
+    if UsedModules.ParentModule is TModuleProgram then begin
+      Emit(ModuleName + ' in ''' + ModuleName + '.pas''');
+      if I < UsedModules.Count - 1 then EmitLn(', ');
+    end else begin
+      Emit(ModuleName);
+      if I < UsedModules.Count - 1 then Emit(', ');
+    end;
+  end;
+  EmitLn(';');
+  Dec(Indetation);
 end;
 
@@ -91 +85 @@
   if Module is TModuleProgram then
   with TModuleProgram(Module) do begin
-    Emit('program', False);
-    Emit(' ' + Name + ';');
-    Emit('');
+    Module.TargetFile := Module.Name + '.dpr';
+    EmitLn('program ' + Name + ';');
     GenerateUses(UsedModules);
     GenerateCommonBlock(Body, '');
-    Emit('.', False);
+    EmitLn('.');
   end else
-  if Module is TModuleUnit then Emit('unit', False)
-  else if Module is TModuleLibrary then Emit('library', False)
-  else if Module is TModulePackage then Emit('package', False);
+  if Module is TModuleUnit then GenerateUnit(Module)
+  else if Module is TModuleLibrary then GenerateLibrary(Module)
+  else if Module is TModulePackage then GeneratePackage(Module);
+end;
+
+procedure TProducerPascal.GenerateUnit(Module: TModule);
+begin
+  EmitLn('unit ' + TModuleUnit(Module).Name + ';');
+  EmitLn;
+  EmitLn('interface');
+  EmitLn;
+  GenerateCommonBlock(TModuleUnit(Module).Body, '.');
+  EmitLn('implementation');
+  EmitLn;
+  EmitLn('end.');
+end;
+
+procedure TProducerPascal.GenerateLibrary(Module: TModule);
+begin
+
+end;
+
+procedure TProducerPascal.GeneratePackage(Module: TModule);
+begin
+
 end;
 
@@ -108 +123 @@
 begin
   if AType is TTypeRecord then begin
-    Emit(AType.Name + ' ' + AssignSymbol + ' record');
+    EmitLn(AType.Name + ' ' + AssignSymbol + ' record');
     Inc(Indetation);
     for I := 0 to TTypeRecord(AType).CommonBlock.Types.Count - 1 do begin
       GenerateType(TType(TTypeRecord(AType).CommonBlock.Types[I]));
-      Emit(';');
+      EmitLn(';');
     end;
     Dec(Indetation);
-    Emit('end', False);
+    Emit('end');
   end else
   if AType is TTypeArray then begin
-    Emit(AType.Name + ' ' + AssignSymbol + ' array ', False);
+    Emit(AType.Name + ' ' + AssignSymbol + ' array ');
     if Assigned(TTypeArray(AType).IndexType) then begin
-      Emit('[', False);
+      Emit('[');
       GenerateType(TTypeArray(AType).IndexType);
-      Emit(']', False);
-    end;
-    Emit(' of ', False);
+      Emit(']');
+    end;
+    Emit(' of ');
     if Assigned(TTypeArray(AType).ItemType) then
       GenerateType(TTypeArray(AType).ItemType);
   end else begin
-    Emit(AType.Name, False);
+    Emit(AType.Name);
     if Assigned(AType.UsedType) then begin
-      Emit(' ' + AssignSymbol + ' ', False);
+      Emit(' ' + AssignSymbol + ' ');
       GenerateType(AType.UsedType);
     end;
@@ -141 +156 @@
 begin
   if Types.Count > 0 then begin
-    Emit('type');
+    EmitLn('type');
     Inc(Indetation);
     for I := 0 to Types.Count - 1 do
@@ -147 +162 @@
     if (not Internal) then begin
       GenerateType(TType(Types[I]), '=');
-      Emit(';');
+      EmitLn(';');
     end;
     Dec(Indetation);
-    Emit('');
+    EmitLn;
   end;
 end;
 
 procedure TProducerPascal.Produce(Module: TModule);
+var
+  I: Integer;
 begin
   inherited;
   TextSource.Clear;
+
+  // Check unit names
+  with Module.ParentProgram do
+  for I := 0 to Modules.Count - 1 do
+    if TModule(Modules[I]).Name = 'System' then
+      TModule(Modules[I]).Name := 'System2';
+
   GenerateModule(Module);
-end;
-
-procedure TProducerPascal.GenerateProgram(ProgramBlock: TProgram);
-var
-  I: Integer;
-begin
-  Indetation := 0;;
-  with ProgramBlock do
-  for I := 0 to Modules.Count - 1 do
-    GenerateModule(TModule(Modules[I]));
 end;
 
@@ -195 +209 @@
     if (FunctionType = ftFunction) and Assigned(ResultType) then
       Line := Line + ': ' + ResultType.Name;
-    Emit(Line + ';');
+    EmitLn(Line + ';');
     GenerateBeginEnd(Code);
-    Emit(';');
-    Emit('');
+    EmitLn(';');
+    EmitLn;
   end;
 end;
@@ -207 +221 @@
 begin
   if Constants.Count > 0 then begin
-    Emit('const');
+    EmitLn('const');
     Inc(Indetation);
     for I := 0 to Constants.Count - 1 do
     with TConstant(Constants[I]) do
     if not System then begin
-      Emit(Name + ': ' + ValueType.Name + ' = ' + Value + ';');
+      //Emit(Name + ': ');
+      //if Assigned(ValueType) then Emit(ValueType.Name);
+      //Emit(' = ' + Value + ';');
     end;
     Dec(Indetation);
@@ -223 +239 @@
   I: Integer;
 begin
-  Emit('begin');
+  EmitLn('begin');
   Inc(Indetation);
   // Commands
   for I := 0 to BeginEnd.Commands.Count - 1 do begin
     GenerateCommand(TCommand(BeginEnd.Commands[I]));
-    Emit(';');
+    EmitLn(';');
   end;
 
   Dec(Indetation);
-  Emit('end', False);
+  Emit('end');
 end;
 
@@ -239 +255 @@
   I: Integer;
 begin
-  Emit('var');
+  EmitLn('var');
   Inc(Indetation);
   for I := 0 to Variables.Count - 1 do
   with TVariable(Variables[I]) do
-    Emit(Name + ': ' + ValueType.Name + ';');
+    EmitLn(Name + ': ' + ValueType.Name + ';');
   Dec(Indetation);
-  Emit('');
+  EmitLn;
 end;
 
@@ -286 +302 @@
 procedure TProducerPascal.GenerateAssignment(Assignment: TAssignment);
 begin
-  Emit(Assignment.Target.Name + ' := ' + GenerateExpression(Assignment.Source), False);
+  Emit(Assignment.Target.Name + ' := ' + GenerateExpression(Assignment.Source));
 end;
 
@@ -305 +321 @@
     end;
   end;
-  Emit(Line, False);
+  Emit(Line);
 end;