Changeset 213


Ignore:
Timestamp:
Apr 22, 2020, 10:23:31 PM (5 years ago)
Author:
chronos
Message:
  • Added: Transformation of Result variable assignment into Return statement.
Location:
branches/interpreter2
Files:
6 edited

Legend:

Unmodified
Added
Removed
  • branches/interpreter2/Forms/UFormMain.lfm

    r210 r213  
    108108      OnExecute = AExitExecute
    109109    end
    110     object AOptimize: TAction
    111       Caption = 'Optimize'
    112       OnExecute = AOptimizeExecute
    113     end
    114110    object AGenerateXml: TAction
    115111      Caption = 'Generate XML'
  • branches/interpreter2/Forms/UFormMain.pas

    r211 r213  
    77uses
    88  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, Menus,
    9   ActnList, ExtCtrls, SynHighlighterPas, SynEdit, USource;
     9  ActnList, ExtCtrls, SynHighlighterPas, SynEdit, USource, UOptimizer;
    1010
    1111type
     
    1616    ACompile: TAction;
    1717    AGenerateXml: TAction;
    18     AOptimize: TAction;
    1918    AExit: TAction;
    2019    ARun: TAction;
     
    4443    procedure AGeneratePhpExecute(Sender: TObject);
    4544    procedure AGenerateXmlExecute(Sender: TObject);
    46     procedure AOptimizeExecute(Sender: TObject);
     45    procedure Optimize(Features: TOptimizeFeatures);
    4746    procedure ARunExecute(Sender: TObject);
    4847    procedure FormActivate(Sender: TObject);
     
    7170uses
    7271  UParser, UExecutor, UGeneratorPascal, UGeneratorPhp, UFormMessages, UFormSource,
    73   UGeneratorCSharp, UOptimizer, UGeneratorXml, UFormOutput;
     72  UGeneratorCSharp, UGeneratorXml, UFormOutput;
    7473
    7574{ TFormMain }
     
    127126begin
    128127  ACompile.Execute;
    129   AOptimize.Execute;
     128  Optimize([ofReplaceResultByReturn, ofReplaceRepeatUntilByWhileDo]);
    130129  FormOutput.SynEditOutput.Highlighter := FormOutput.SynCppSyn1;
    131130  FormOutput.Clear;
     
    145144begin
    146145  ACompile.Execute;
    147   AOptimize.Execute;
    148146  FormOutput.SynEditOutput.Highlighter := FormOutput.SynPasSyn1;
    149147  FormOutput.SynEditOutput.Lines.Clear;
     
    163161begin
    164162  ACompile.Execute;
     163  Optimize([ofReplaceResultByReturn, ofReplaceRepeatUntilByWhileDo]);
    165164  FormOutput.SynEditOutput.Highlighter := FormOutput.SynPhpSyn1;
    166165  FormOutput.SynEditOutput.Lines.Clear;
     
    192191end;
    193192
    194 procedure TFormMain.AOptimizeExecute(Sender: TObject);
     193procedure TFormMain.Optimize(Features: TOptimizeFeatures);
    195194var
    196195  Optimizer: TOptimizer;
     
    198197  if Assigned(Prog) then begin
    199198    Optimizer := TOptimizer.Create;
     199    Optimizer.Features := Features;
    200200    Optimizer.Prog := Prog;
    201201    Optimizer.Optimize;
     
    209209begin
    210210  ACompile.Execute;
    211   AOptimize.Execute;
    212211  FormOutput.SynEditOutput.Highlighter := nil;
    213212  FormOutput.SynEditOutput.Lines.Clear;
  • branches/interpreter2/UGeneratorCSharp.pas

    r212 r213  
    2020    procedure GenerateBlockVar(ParentBlock: TBlock; Block: TBlock);
    2121    procedure GenerateBlockFunctions(ParentBlock: TBlock; Block: TBlock);
    22     procedure GenerateBeginEnd(Block: TBlock; BeginEnd: TBeginEnd);
     22    procedure GenerateBeginEnd(Block: TBlock; BeginEnd: TBeginEnd; Enclosed: Boolean = True);
    2323    procedure GenerateCommand(Block: TBlock; Command: TCommand);
    2424    procedure GenerateIfThenElse(Block: TBlock; IfThenElse: TIfThenElse);
     
    3333    procedure GenerateBreak(Block: TBlock; BreakCmd: TBreak);
    3434    procedure GenerateContinue(Block: TBlock; ContinueCmd: TContinue);
     35    procedure GenerateReturn(Block: TBlock; Return: TReturn);
    3536    procedure GenerateTypeRef(TypeRef: TType);
    3637    procedure GenerateValue(Value: TValue);
     
    5556  else if Command is TBreak then GenerateBreak(Block, TBreak(Command))
    5657  else if Command is TContinue then GenerateContinue(Block, TContinue(Command))
     58  else if Command is TReturn then GenerateReturn(Block, TReturn(Command))
    5759  else if Command is TEmptyCommand then
    5860  else raise Exception.Create('Unsupported command type');
     
    184186end;
    185187
     188procedure TGeneratorCSharp.GenerateReturn(Block: TBlock; Return: TReturn);
     189begin
     190  AddText('return ');
     191  GenerateExpression(Block, Return.Expression);
     192end;
     193
    186194procedure TGeneratorCSharp.GenerateTypeRef(TypeRef: TType);
    187195begin
     
    209217  AddTextLine('{');
    210218  Indent := Indent + 1;
     219  GenerateBlockFunctions(nil, Prog.SystemBlock);
    211220  GenerateBlock(nil, Prog.SystemBlock);
    212221  AddTextLine('public static void Main()');
     
    216225  AddTextLine('}');
    217226  AddTextLine();
     227  GenerateBlockFunctions(Prog.Block, Prog.Block);
    218228  AddTextLine('public void Entry()');
    219229  GenerateBlock(Block, Prog.Block);
     
    223233
    224234procedure TGeneratorCSharp.GenerateBlock(ParentBlock: TBlock; Block: TBlock);
    225 begin
    226   GenerateBlockVar(Block, Block);
    227   GenerateBlockConst(Block, Block);
    228   GenerateBlockFunctions(Block, Block);
     235var
     236  I: Integer;
     237begin
    229238  if Block.BeginEnd.Commands.Count > 0 then begin
    230     GenerateBeginEnd(ParentBlock, Block.BeginEnd);
    231     AddTextLine;
     239    AddTextLine('{');
     240    Indent := Indent + 1;
     241    GenerateBlockVar(Block, Block);
     242    GenerateBlockConst(Block, Block);
     243    GenerateBeginEnd(ParentBlock, Block.BeginEnd, False);
     244    Indent := Indent - 1;
     245    AddTextLine('}');
    232246  end;
    233247end;
     
    245259    AddTextLine(';');
    246260  end;
     261  if Block.Constants.Count > 0 then AddTextLine;
    247262end;
    248263
     
    251266  I: Integer;
    252267  Variable: TVariable;
    253 begin
    254   if Block.Variables.Count > 0 then begin
     268  VarCount: Integer;
     269begin
     270  VarCount := 0;
     271  for I := 0 to Block.Variables.Count - 1 do
     272    if not TVariable(Block.Variables[I]).Internal then Inc(VarCount);
     273  if VarCount > 0 then begin
    255274    for I := 0 to Block.Variables.Count - 1 do
    256275    if not TVariable(Block.Variables[I]).Internal then begin
     
    259278      AddTextLine(' ' + Variable.Name + ';');
    260279    end;
    261     AddTextLine;
    262   end;
     280  end;
     281  if VarCount > 0 then AddTextLine;
    263282end;
    264283
     
    310329end;
    311330
    312 procedure TGeneratorCSharp.GenerateBeginEnd(Block: TBlock; BeginEnd: TBeginEnd);
    313 var
    314   I: Integer;
    315 begin
    316   AddTextLine('{');
    317   Indent := Indent + 1;
     331procedure TGeneratorCSharp.GenerateBeginEnd(Block: TBlock; BeginEnd: TBeginEnd; Enclosed: Boolean = True);
     332var
     333  I: Integer;
     334begin
     335  if Enclosed then begin
     336    AddTextLine('{');
     337    Indent := Indent + 1;
     338  end;
    318339  for I := 0 to BeginEnd.Commands.Count - 1 do begin
    319340    GenerateCommand(Block, TCommand(BeginEnd.Commands[I]));
    320341    AddTextLine(';');
    321342  end;
    322   Indent := Indent - 1;
    323   AddText('}');
     343  if Enclosed then begin
     344    Indent := Indent - 1;
     345    AddText('}');
     346  end;
    324347end;
    325348
  • branches/interpreter2/UGeneratorPhp.pas

    r212 r213  
    3131    procedure GenerateExpressionOperand(Block: TBlock; Expression: TExpressionOperand);
    3232    procedure GenerateBreak(Block: TBlock; BreakCmd: TBreak);
     33    procedure GenerateReturn(Block: TBlock; Return: TReturn);
    3334    procedure GenerateContinue(Block: TBlock; ContinueCmd: TContinue);
    3435    procedure GenerateValue(Value: TValue);
     
    5354  else if Command is TBreak then GenerateBreak(Block, TBreak(Command))
    5455  else if Command is TContinue then GenerateContinue(Block, TContinue(Command))
     56  else if Command is TReturn then GenerateReturn(Block, TReturn(Command))
    5557  else if Command is TEmptyCommand then
    5658  else raise Exception.Create('Unsupported command type');
     
    177179begin
    178180  AddText('break');
     181end;
     182
     183procedure TGeneratorPhp.GenerateReturn(Block: TBlock; Return: TReturn);
     184begin
     185  AddText('return ');
     186  GenerateExpression(Block, Return.Expression);
    179187end;
    180188
  • branches/interpreter2/UOptimizer.pas

    r211 r213  
    99
    1010type
     11  TOptimizeFeature = (ofReplaceRepeatUntilByWhileDo, ofReplaceResultByReturn);
     12  TOptimizeFeatures = set of TOptimizeFeature;
    1113
    1214  { TOptimizer }
     
    1820  public
    1921    Prog: TProgram;
     22    Features: TOptimizeFeatures;
    2023    procedure Optimize;
    2124  end;
     
    2932var
    3033  I: Integer;
     34  TempNewNode: TSourceNode;
    3135begin
    3236  for I := 0 to SourceNodes.Count - 1 do begin
    3337    if SourceNodes[I] is TSourceNode then begin
    34       OptimizeNode(TSourceNode(SourceNodes[I]), NewNode);
    35       if Assigned(NewNode) and (NewNode <> TSourceNode(SourceNodes[I])) then begin
    36         SourceNodes[I] := NewNode;
     38      OptimizeNode(TSourceNode(SourceNodes[I]), TempNewNode);
     39      if Assigned(TempNewNode) and (TempNewNode <> TSourceNode(SourceNodes[I])) then begin
     40        SourceNodes[I] := TempNewNode;
    3741      end;
    3842    end else raise Exception.Create('Unsupported node type');
     
    4650  WhileDo: TWhileDo;
    4751  Condition: TIfThenElse;
     52  Return: TReturn;
    4853  Field: TField;
    4954  Obj: TObject;
     55  TempNewNode: TSourceNode;
    5056begin
    5157  NewNode := nil;
     
    5561    OptimizeNodes(TSourceNodes(SourceNode), NewNode)
    5662  end else
    57   if SourceNode is TRepeatUntil then begin
     63  if (ofReplaceRepeatUntilByWhileDo in Features) and (SourceNode is TRepeatUntil) then begin
    5864    WhileDo := TWhileDo.Create;
    5965    WhileDo.Command := TBeginEnd.Create;
     
    7985    NewNode := WhileDo;
    8086  end else
     87  if (ofReplaceResultByReturn in Features) and (SourceNode is TAssignment) then begin
     88    if TAssignment(SourceNode).Variable.Name = 'Result' then begin
     89      Return := TReturn.Create;
     90      Return.Parent := TAssignment(SourceNode).Parent;
     91      Return.Expression.Free;
     92      Return.Expression := TAssignment(SourceNode).Expression;
     93      Return.Expression.Parent := Return;
     94      TAssignment(SourceNode).Expression := TExpression.Create;
     95      NewNode := Return;
     96    end;
     97  end else
    8198  if SourceNode is TSourceNode then begin
    8299    for I := 0 to SourceNode.FieldsCount - 1 do begin
     
    85102        SourceNode.GetValue(I, Obj);
    86103        if Obj is TSourceNode then begin
    87           OptimizeNode(TSourceNode(Obj), NewNode);
    88           if Assigned(NewNode) and (NewNode <> TSourceNode(Obj)) then begin
    89             SourceNode.SetValueObject(I, NewNode);
     104          OptimizeNode(TSourceNode(Obj), TempNewNode);
     105          if Assigned(TempNewNode) and (TempNewNode <> TSourceNode(Obj)) then begin
     106            SourceNode.SetValueObject(I, TempNewNode);
    90107          end;
    91108        end;
  • branches/interpreter2/USource.pas

    r212 r213  
    308308  end;
    309309
     310  { TReturn }
     311
     312  TReturn = class(TCommand)
     313  private
     314    function GetFieldsCount: Integer; override;
     315  public
     316    Expression: TExpression;
     317    procedure GetValue(Index: Integer; out Value); override;
     318    function GetField(Index: Integer): TField; override;
     319    procedure SetValue(Index: Integer; var Value); override;
     320    constructor Create;
     321    destructor Destroy; override;
     322  end;
     323
    310324  { TIfThenElse }
    311325
     
    437451  SYes = 'Yes';
    438452  SNo = 'No';
     453
     454{ TReturn }
     455
     456function TReturn.GetFieldsCount: Integer;
     457begin
     458  Result := 1;
     459end;
     460
     461procedure TReturn.GetValue(Index: Integer; out Value);
     462begin
     463  if Index = 0 then TExpression(Value) := Expression
     464  else inherited;
     465end;
     466
     467function TReturn.GetField(Index: Integer): TField;
     468begin
     469  if Index = 0 then Result := TField.Create(dtObject, 'Expression')
     470  else inherited;
     471end;
     472
     473procedure TReturn.SetValue(Index: Integer; var Value);
     474begin
     475  if Index = 0 then Expression := TExpression(Value)
     476  else inherited;
     477end;
     478
     479constructor TReturn.Create;
     480begin
     481  Expression := TExpression.Create;
     482end;
     483
     484destructor TReturn.Destroy;
     485begin
     486  Expression.Free;
     487  inherited Destroy;
     488end;
    439489
    440490{ TField }
Note: See TracChangeset for help on using the changeset viewer.