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

Timestamp:

Aug 9, 2010, 12:48:14 PM (14 years ago)

Author:

george

Message:

Support for function definition with result type.

File:

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

branches/DelphiToC/Produce/UProducerPascal.pas

@@ -7 +7 @@
 uses
   SysUtils, Variants, Classes, Graphics, Controls, Forms,
-  Dialogs, StdCtrls, UPascalSource, UCodeProducer, StrUtils;
+  Dialogs, UPascalSource, UCodeProducer, StrUtils;
 
 type
@@ -21 +21 @@
       LabelPrefix: string);
     procedure GenerateProgram(ProgramBlock: TProgram);
-    procedure GenerateMethods(Methods: TFunctionList);
+    procedure GenerateFunctions(Functions: TFunctionList);
     procedure GenerateBeginEnd(BeginEnd: TBeginEnd);
     procedure GenerateVariableList(Variables: TVariableList);
@@ -28 +28 @@
     procedure GenerateIfThenElse(IfThenElse: TIfThenElse);
     procedure GenerateAssignment(Assignment: TAssignment);
-    procedure GenerateMethodCall(MethodCall: TMethodCall);
+    procedure GenerateMethodCall(MethodCall: TFunctionCall);
     function GenerateExpression(Expression: TExpression): string;
   public
@@ -97 +97 @@
 end;
 
-procedure TProducerPascal.GenerateMethods(Methods: TFunctionList);
-var
-  I: Integer;
-begin
-  for I := 0 to Methods.Count - 1 do
-  with TFunction(Methods[I]) do
+procedure TProducerPascal.GenerateFunctions(Functions: TFunctionList);
+var
+  I: Integer;
+  P: Integer;
+  Line: string;
+begin
+  for I := 0 to Functions.Count - 1 do
+  with TFunction(Functions[I]) do
   begin
-    Emit('procedure ' + Name + '');
+    if HaveResult then
+      Line := 'function ' + Name
+      else Line := 'procedure ' + Name;
+    if Parameters.Count > 0 then begin
+      Line := Line + '(';
+      for P := 0 to Parameters.Count - 1 do begin
+        with TParameter(Parameters[P]) do
+          Line := Line + Name + ': ' + ValueType.Name;
+        if P < (Parameters.Count - 1) then Line := Line + '; ';
+      end;
+      Line := Line + ')';
+    end;
+    if HaveResult then Line := Line + ': ' + ResultType.Name;
+    Emit(Line + ';');
     GenerateBeginEnd(Code);
     Emit('');
@@ -121 +136 @@
 
   Dec(Indetation);
-  Emit('end');
+  Emit('end;');
 end;
 
@@ -141 +156 @@
   else if Command is TIfThenElse then GenerateIfThenElse(TIfThenElse(Command))
   else if Command is TAssignment then GenerateAssignment(TAssignment(Command))
-  else if Command is TMethodCall then GenerateMethodCall(TMethodCall(Command));
+  else if Command is TFunctionCall then GenerateMethodCall(TFunctionCall(Command));
 end;
 
@@ -154 +169 @@
   Emit('if ' + GenerateExpression(IfThenElse.Condition) + ' then ');
   GenerateCommand(IfThenElse.Command);
-  Emit('else ');
-  GenerateCommand(IfThenElse.ElseCommand);
+  if Assigned(IfThenElse.ElseCommand) then begin
+    Emit('else ');
+    GenerateCommand(IfThenElse.ElseCommand);
+  end;
 end;
 
 procedure TProducerPascal.GenerateAssignment(Assignment: TAssignment);
 begin
-  Emit(Assignment.Target.Name + ' = ' + GenerateExpression(Assignment.Source) + ';');
-end;
-
-procedure TProducerPascal.GenerateMethodCall(MethodCall: TMethodCall);
-begin
-  Emit(MethodCall.Method.Name + ';');
+  Emit(Assignment.Target.Name + ' := ' + GenerateExpression(Assignment.Source) + ';');
+end;
+
+procedure TProducerPascal.GenerateMethodCall(MethodCall: TFunctionCall);
+begin
+  Emit(MethodCall.FunctionRef.Name + ';');
 end;
 
@@ -189 +206 @@
 begin
   with CommonBlock do begin
-    GenerateMethods(Methods);
+    GenerateFunctions(Methods);
     Emit('procedure ' + Name + '');
     GenerateBeginEnd(Code);