Changeset 53 for branches/DelphiToC/Produce/UProducerPascal.pas

Timestamp:

Aug 10, 2010, 10:14:57 AM (14 years ago)

Author:

george

Message:

Project renamed to Transpascal.
Added support for generatin cycle For-to-do.
Added support for parsing and generating structured types as record and array.
Emit procedure in TProducerPascal and TProducerC reworked.

File:

• branches/DelphiToC/Produce/UProducerPascal.pas (modified) (13 diffs)

branches/DelphiToC/Produce/UProducerPascal.pas

@@ -15 +15 @@
   TProducerPascal = class(TProducer)
   private
-    procedure Emit(Text: string; NewLine: Boolean = True);
+    procedure Emit(AText: string; NewLine: Boolean = True);
     procedure GenerateUses(UsedModules: TUsedModuleList);
     procedure GenerateModule(Module: TModule);
+    procedure GenerateType(AType: TType; AssignSymbol: Char = ':');
+    procedure GenerateTypes(Types: TTypeList);
     procedure GenerateCommonBlock(CommonBlock: TCommonBlock;
       LabelPrefix: string);
@@ -27 +29 @@
     procedure GenerateCommand(Command: TCommand);
     procedure GenerateWhileDo(WhileDo: TWhileDo);
+    procedure GenerateForToDo(ForToDo: TForToDo);
     procedure GenerateIfThenElse(IfThenElse: TIfThenElse);
     procedure GenerateAssignment(Assignment: TAssignment);
@@ -56 +59 @@
 end;
 
-procedure TProducerPascal.Emit(Text: string; NewLine: Boolean = True);
-begin
-  if NewLine then TextSource.Add(DupeString(' ', IndentationLength * Indetation) + Text)
-    else TextSource.Strings[TextSource.Count - 1] := TextSource.Strings[TextSource.Count - 1] + Text;
+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;
 
@@ -83 +91 @@
   GenerateCommonBlock(Module, '');
   Emit('.', False);
+end;
+
+procedure TProducerPascal.GenerateType(AType: TType; AssignSymbol: Char = ':');
+var
+  I: Integer;
+begin
+  if AType is TTypeRecord then begin
+    Emit(AType.Name + ' ' + AssignSymbol + ' record');
+    Inc(Indetation);
+    for I := 0 to TTypeRecord(AType).Items.Count - 1 do begin
+      GenerateType(TType(TTypeRecord(AType).Items[I]));
+      Emit(';');
+    end;
+    Dec(Indetation);
+    Emit('end', False);
+  end else
+  if AType is TTypeArray then begin
+    Emit(AType.Name + ' ' + AssignSymbol + ' array ', False);
+    if Assigned(TTypeArray(AType).IndexType) then begin
+      Emit('[', False);
+      GenerateType(TTypeArray(AType).IndexType);
+      Emit(']', False);
+    end;
+    Emit(' of ', False);
+    if Assigned(TTypeArray(AType).ItemType) then
+      GenerateType(TTypeArray(AType).ItemType);
+  end else begin
+    Emit(AType.Name, False);
+    if Assigned(AType.UsedType) then begin
+      Emit(' ' + AssignSymbol + ' ', False);
+      GenerateType(AType.UsedType);
+    end;
+  end;
+end;
+
+procedure TProducerPascal.GenerateTypes(Types: TTypeList);
+var
+  I: Integer;
+begin
+  if Types.Count > 0 then begin
+    Emit('type');
+    Inc(Indetation);
+    for I := 0 to Types.Count - 1 do
+    with TType(Types[I]) do
+    if (not System) then begin
+      GenerateType(TType(Types[I]), '=');
+      Emit(';');
+    end;
+    Dec(Indetation);
+    Emit('');
+  end;
 end;
 
@@ -127 +186 @@
     Emit(Line + ';');
     GenerateBeginEnd(Code);
-    Emit(';', False);
+    Emit(';');
     Emit('');
   end;
@@ -136 +195 @@
   I: Integer;
 begin
-  Emit('const');
-  Inc(Indetation);
-  for I := 0 to Constants.Count - 1 do
-  with TConstant(Constants[I]) do
-    Emit(Name + ': ' + ValueType.Name + ' = ' + Value + ';');
-  Dec(Indetation);
-  Emit('');
+  if Constants.Count > 0 then begin
+    Emit('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 + ';');
+    end;
+    Dec(Indetation);
+    Emit('');
+  end;
 end;
 
@@ -154 +217 @@
   for I := 0 to BeginEnd.Commands.Count - 1 do begin
     GenerateCommand(TCommand(BeginEnd.Commands[I]));
-    Emit(';', False);
+    Emit(';');
   end;
 
   Dec(Indetation);
-  Emit('end');
+  Emit('end', False);
 end;
 
@@ -178 +241 @@
   if Command is TBeginEnd then GenerateBeginEnd(TBeginEnd(Command))
   else if Command is TWhileDo then GenerateWhileDo(TWhileDo(Command))
+  else if Command is TForToDo then GenerateForToDo(TForToDo(Command))
   else if Command is TIfThenElse then GenerateIfThenElse(TIfThenElse(Command))
   else if Command is TAssignment then GenerateAssignment(TAssignment(Command))
@@ -189 +253 @@
 end;
 
+procedure TProducerPascal.GenerateForToDo(ForToDo: TForToDo);
+begin
+  with ForToDo do begin
+    Emit('for ' + ControlVariable.Name + ' := ' +
+      GenerateExpression(Start) + ' to ' + GenerateExpression(Stop) + ' do ');
+    GenerateCommand(Command);
+  end;
+end;
+
 procedure TProducerPascal.GenerateIfThenElse(IfThenElse: TIfThenElse);
 begin
@@ -194 +267 @@
   GenerateCommand(IfThenElse.Command);
   if Assigned(IfThenElse.ElseCommand) then begin
-    Emit('else ');
+    Emit(' else ');
     GenerateCommand(IfThenElse.ElseCommand);
   end;
@@ -201 +274 @@
 procedure TProducerPascal.GenerateAssignment(Assignment: TAssignment);
 begin
-  Emit(Assignment.Target.Name + ' := ' + GenerateExpression(Assignment.Source));
+  Emit(Assignment.Target.Name + ' := ' + GenerateExpression(Assignment.Source), False);
 end;
 
@@ -220 +293 @@
     end;
   end;
-  Emit(Line);
+  Emit(Line, False);
 end;
 
@@ -244 +317 @@
 begin
   with CommonBlock do begin
+    GenerateTypes(Types);
     GenerateFunctions(Functions);
     GenerateConstants(Constants);