Changeset 213

Timestamp:

Apr 22, 2020, 10:23:31 PM (4 years ago)

Author:

chronos

Message:

• Added: Transformation of Result variable assignment into Return statement.

Location:

branches/interpreter2

Files:

• Forms/UFormMain.lfm (modified) (1 diff)
• Forms/UFormMain.pas (modified) (10 diffs)
• UGeneratorCSharp.pas (modified) (11 diffs)
• UGeneratorPhp.pas (modified) (3 diffs)
• UOptimizer.pas (modified) (7 diffs)
• USource.pas (modified) (2 diffs)

branches/interpreter2/Forms/UFormMain.lfm

@@ -108 +108 @@
       OnExecute = AExitExecute
     end
-    object AOptimize: TAction
-      Caption = 'Optimize'
-      OnExecute = AOptimizeExecute
-    end
     object AGenerateXml: TAction
       Caption = 'Generate XML'

branches/interpreter2/Forms/UFormMain.pas

@@ -7 +7 @@
 uses
   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, Menus,
-  ActnList, ExtCtrls, SynHighlighterPas, SynEdit, USource;
+  ActnList, ExtCtrls, SynHighlighterPas, SynEdit, USource, UOptimizer;
 
 type
@@ -16 +16 @@
     ACompile: TAction;
     AGenerateXml: TAction;
-    AOptimize: TAction;
     AExit: TAction;
     ARun: TAction;
@@ -44 +43 @@
     procedure AGeneratePhpExecute(Sender: TObject);
     procedure AGenerateXmlExecute(Sender: TObject);
-    procedure AOptimizeExecute(Sender: TObject);
+    procedure Optimize(Features: TOptimizeFeatures);
     procedure ARunExecute(Sender: TObject);
     procedure FormActivate(Sender: TObject);
@@ -71 +70 @@
 uses
   UParser, UExecutor, UGeneratorPascal, UGeneratorPhp, UFormMessages, UFormSource,
-  UGeneratorCSharp, UOptimizer, UGeneratorXml, UFormOutput;
+  UGeneratorCSharp, UGeneratorXml, UFormOutput;
 
 { TFormMain }
@@ -127 +126 @@
 begin
   ACompile.Execute;
-  AOptimize.Execute;
+  Optimize([ofReplaceResultByReturn, ofReplaceRepeatUntilByWhileDo]);
   FormOutput.SynEditOutput.Highlighter := FormOutput.SynCppSyn1;
   FormOutput.Clear;
@@ -145 +144 @@
 begin
   ACompile.Execute;
-  AOptimize.Execute;
   FormOutput.SynEditOutput.Highlighter := FormOutput.SynPasSyn1;
   FormOutput.SynEditOutput.Lines.Clear;
@@ -163 +161 @@
 begin
   ACompile.Execute;
+  Optimize([ofReplaceResultByReturn, ofReplaceRepeatUntilByWhileDo]);
   FormOutput.SynEditOutput.Highlighter := FormOutput.SynPhpSyn1;
   FormOutput.SynEditOutput.Lines.Clear;
@@ -192 +191 @@
 end;
 
-procedure TFormMain.AOptimizeExecute(Sender: TObject);
+procedure TFormMain.Optimize(Features: TOptimizeFeatures);
 var
   Optimizer: TOptimizer;
@@ -198 +197 @@
   if Assigned(Prog) then begin
     Optimizer := TOptimizer.Create;
+    Optimizer.Features := Features;
     Optimizer.Prog := Prog;
     Optimizer.Optimize;
@@ -209 +209 @@
 begin
   ACompile.Execute;
-  AOptimize.Execute;
   FormOutput.SynEditOutput.Highlighter := nil;
   FormOutput.SynEditOutput.Lines.Clear;

branches/interpreter2/UGeneratorCSharp.pas

@@ -20 +20 @@
     procedure GenerateBlockVar(ParentBlock: TBlock; Block: TBlock);
     procedure GenerateBlockFunctions(ParentBlock: TBlock; Block: TBlock);
-    procedure GenerateBeginEnd(Block: TBlock; BeginEnd: TBeginEnd);
+    procedure GenerateBeginEnd(Block: TBlock; BeginEnd: TBeginEnd; Enclosed: Boolean = True);
     procedure GenerateCommand(Block: TBlock; Command: TCommand);
     procedure GenerateIfThenElse(Block: TBlock; IfThenElse: TIfThenElse);
@@ -33 +33 @@
     procedure GenerateBreak(Block: TBlock; BreakCmd: TBreak);
     procedure GenerateContinue(Block: TBlock; ContinueCmd: TContinue);
+    procedure GenerateReturn(Block: TBlock; Return: TReturn);
     procedure GenerateTypeRef(TypeRef: TType);
     procedure GenerateValue(Value: TValue);
@@ -55 +56 @@
   else if Command is TBreak then GenerateBreak(Block, TBreak(Command))
   else if Command is TContinue then GenerateContinue(Block, TContinue(Command))
+  else if Command is TReturn then GenerateReturn(Block, TReturn(Command))
   else if Command is TEmptyCommand then
   else raise Exception.Create('Unsupported command type');
@@ -184 +186 @@
 end;
 
+procedure TGeneratorCSharp.GenerateReturn(Block: TBlock; Return: TReturn);
+begin
+  AddText('return ');
+  GenerateExpression(Block, Return.Expression);
+end;
+
 procedure TGeneratorCSharp.GenerateTypeRef(TypeRef: TType);
 begin
@@ -209 +217 @@
   AddTextLine('{');
   Indent := Indent + 1;
+  GenerateBlockFunctions(nil, Prog.SystemBlock);
   GenerateBlock(nil, Prog.SystemBlock);
   AddTextLine('public static void Main()');
@@ -216 +225 @@
   AddTextLine('}');
   AddTextLine();
+  GenerateBlockFunctions(Prog.Block, Prog.Block);
   AddTextLine('public void Entry()');
   GenerateBlock(Block, Prog.Block);
@@ -223 +233 @@
 
 procedure TGeneratorCSharp.GenerateBlock(ParentBlock: TBlock; Block: TBlock);
-begin
-  GenerateBlockVar(Block, Block);
-  GenerateBlockConst(Block, Block);
-  GenerateBlockFunctions(Block, Block);
+var
+  I: Integer;
+begin
   if Block.BeginEnd.Commands.Count > 0 then begin
-    GenerateBeginEnd(ParentBlock, Block.BeginEnd);
-    AddTextLine;
+    AddTextLine('{');
+    Indent := Indent + 1;
+    GenerateBlockVar(Block, Block);
+    GenerateBlockConst(Block, Block);
+    GenerateBeginEnd(ParentBlock, Block.BeginEnd, False);
+    Indent := Indent - 1;
+    AddTextLine('}');
   end;
 end;
@@ -245 +259 @@
     AddTextLine(';');
   end;
+  if Block.Constants.Count > 0 then AddTextLine;
 end;
 
@@ -251 +266 @@
   I: Integer;
   Variable: TVariable;
-begin
-  if Block.Variables.Count > 0 then begin
+  VarCount: Integer;
+begin
+  VarCount := 0;
+  for I := 0 to Block.Variables.Count - 1 do
+    if not TVariable(Block.Variables[I]).Internal then Inc(VarCount);
+  if VarCount > 0 then begin
     for I := 0 to Block.Variables.Count - 1 do
     if not TVariable(Block.Variables[I]).Internal then begin
@@ -259 +278 @@
       AddTextLine(' ' + Variable.Name + ';');
     end;
-    AddTextLine;
-  end;
+  end;
+  if VarCount > 0 then AddTextLine;
 end;
 
@@ -310 +329 @@
 end;
 
-procedure TGeneratorCSharp.GenerateBeginEnd(Block: TBlock; BeginEnd: TBeginEnd);
-var
-  I: Integer;
-begin
-  AddTextLine('{');
-  Indent := Indent + 1;
+procedure TGeneratorCSharp.GenerateBeginEnd(Block: TBlock; BeginEnd: TBeginEnd; Enclosed: Boolean = True);
+var
+  I: Integer;
+begin
+  if Enclosed then begin
+    AddTextLine('{');
+    Indent := Indent + 1;
+  end;
   for I := 0 to BeginEnd.Commands.Count - 1 do begin
     GenerateCommand(Block, TCommand(BeginEnd.Commands[I]));
     AddTextLine(';');
   end;
-  Indent := Indent - 1;
-  AddText('}');
+  if Enclosed then begin
+    Indent := Indent - 1;
+    AddText('}');
+  end;
 end;
 

branches/interpreter2/UGeneratorPhp.pas

@@ -31 +31 @@
     procedure GenerateExpressionOperand(Block: TBlock; Expression: TExpressionOperand);
     procedure GenerateBreak(Block: TBlock; BreakCmd: TBreak);
+    procedure GenerateReturn(Block: TBlock; Return: TReturn);
     procedure GenerateContinue(Block: TBlock; ContinueCmd: TContinue);
     procedure GenerateValue(Value: TValue);
@@ -53 +54 @@
   else if Command is TBreak then GenerateBreak(Block, TBreak(Command))
   else if Command is TContinue then GenerateContinue(Block, TContinue(Command))
+  else if Command is TReturn then GenerateReturn(Block, TReturn(Command))
   else if Command is TEmptyCommand then
   else raise Exception.Create('Unsupported command type');
@@ -177 +179 @@
 begin
   AddText('break');
+end;
+
+procedure TGeneratorPhp.GenerateReturn(Block: TBlock; Return: TReturn);
+begin
+  AddText('return ');
+  GenerateExpression(Block, Return.Expression);
 end;
 

branches/interpreter2/UOptimizer.pas

@@ -9 +9 @@
 
 type
+  TOptimizeFeature = (ofReplaceRepeatUntilByWhileDo, ofReplaceResultByReturn);
+  TOptimizeFeatures = set of TOptimizeFeature;
 
   { TOptimizer }
@@ -18 +20 @@
   public
     Prog: TProgram;
+    Features: TOptimizeFeatures;
     procedure Optimize;
   end;
@@ -29 +32 @@
 var
   I: Integer;
+  TempNewNode: TSourceNode;
 begin
   for I := 0 to SourceNodes.Count - 1 do begin
     if SourceNodes[I] is TSourceNode then begin
-      OptimizeNode(TSourceNode(SourceNodes[I]), NewNode);
-      if Assigned(NewNode) and (NewNode <> TSourceNode(SourceNodes[I])) then begin
-        SourceNodes[I] := NewNode;
+      OptimizeNode(TSourceNode(SourceNodes[I]), TempNewNode);
+      if Assigned(TempNewNode) and (TempNewNode <> TSourceNode(SourceNodes[I])) then begin
+        SourceNodes[I] := TempNewNode;
       end;
     end else raise Exception.Create('Unsupported node type');
@@ -46 +50 @@
   WhileDo: TWhileDo;
   Condition: TIfThenElse;
+  Return: TReturn;
   Field: TField;
   Obj: TObject;
+  TempNewNode: TSourceNode;
 begin
   NewNode := nil;
@@ -55 +61 @@
     OptimizeNodes(TSourceNodes(SourceNode), NewNode)
   end else
-  if SourceNode is TRepeatUntil then begin
+  if (ofReplaceRepeatUntilByWhileDo in Features) and (SourceNode is TRepeatUntil) then begin
     WhileDo := TWhileDo.Create;
     WhileDo.Command := TBeginEnd.Create;
@@ -79 +85 @@
     NewNode := WhileDo;
   end else
+  if (ofReplaceResultByReturn in Features) and (SourceNode is TAssignment) then begin
+    if TAssignment(SourceNode).Variable.Name = 'Result' then begin
+      Return := TReturn.Create;
+      Return.Parent := TAssignment(SourceNode).Parent;
+      Return.Expression.Free;
+      Return.Expression := TAssignment(SourceNode).Expression;
+      Return.Expression.Parent := Return;
+      TAssignment(SourceNode).Expression := TExpression.Create;
+      NewNode := Return;
+    end;
+  end else
   if SourceNode is TSourceNode then begin
     for I := 0 to SourceNode.FieldsCount - 1 do begin
@@ -85 +102 @@
         SourceNode.GetValue(I, Obj);
         if Obj is TSourceNode then begin
-          OptimizeNode(TSourceNode(Obj), NewNode);
-          if Assigned(NewNode) and (NewNode <> TSourceNode(Obj)) then begin
-            SourceNode.SetValueObject(I, NewNode);
+          OptimizeNode(TSourceNode(Obj), TempNewNode);
+          if Assigned(TempNewNode) and (TempNewNode <> TSourceNode(Obj)) then begin
+            SourceNode.SetValueObject(I, TempNewNode);
           end;
         end;

branches/interpreter2/USource.pas

@@ -308 +308 @@
   end;
 
+  { TReturn }
+
+  TReturn = class(TCommand)
+  private
+    function GetFieldsCount: Integer; override;
+  public
+    Expression: TExpression;
+    procedure GetValue(Index: Integer; out Value); override;
+    function GetField(Index: Integer): TField; override;
+    procedure SetValue(Index: Integer; var Value); override;
+    constructor Create;
+    destructor Destroy; override;
+  end;
+
   { TIfThenElse }
 
@@ -437 +451 @@
   SYes = 'Yes';
   SNo = 'No';
+
+{ TReturn }
+
+function TReturn.GetFieldsCount: Integer;
+begin
+  Result := 1;
+end;
+
+procedure TReturn.GetValue(Index: Integer; out Value);
+begin
+  if Index = 0 then TExpression(Value) := Expression
+  else inherited;
+end;
+
+function TReturn.GetField(Index: Integer): TField;
+begin
+  if Index = 0 then Result := TField.Create(dtObject, 'Expression')
+  else inherited;
+end;
+
+procedure TReturn.SetValue(Index: Integer; var Value);
+begin
+  if Index = 0 then Expression := TExpression(Value)
+  else inherited;
+end;
+
+constructor TReturn.Create;
+begin
+  Expression := TExpression.Create;
+end;
+
+destructor TReturn.Destroy;
+begin
+  Expression.Free;
+  inherited Destroy;
+end;
 
 { TField }