source: branches/xpascal/Optimizer.pas

unit Optimizer;

interface

uses
  Classes, SysUtils, Source, SourceNode;

type
  TOptimizeFeature = (ofReplaceRepeatUntilByWhileDo, ofReplaceResultByReturn);
  TOptimizeFeatures = set of TOptimizeFeature;

  { TOptimizer }

  TOptimizer = class
  private
    procedure OptimizeNodes(SourceNodes: TSourceNodeList<TSourceNode>; out NewNode: TSourceNode);
    procedure OptimizeNode(SourceNode: TSourceNode; out NewNode: TSourceNode);
  public
    Prog: TProgram;
    Features: TOptimizeFeatures;
    procedure Optimize;
  end;

implementation

resourcestring
  SUnsupportedNodeType = 'Unsupported node type';

{ TOptimizer }

procedure TOptimizer.OptimizeNodes(SourceNodes: TSourceNodeList<TSourceNode>; out
  NewNode: TSourceNode);
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]), TempNewNode);
      if Assigned(TempNewNode) and (TempNewNode <> TSourceNode(SourceNodes[I])) then begin
        SourceNodes[I] := TempNewNode;
      end;
    end else raise Exception.Create(SUnsupportedNodeType);
  end;
end;

procedure TOptimizer.OptimizeNode(SourceNode: TSourceNode; out
  NewNode: TSourceNode);
var
  I: Integer;
  WhileDo: TWhileDo;
  Condition: TIfThenElse;
  Return: TReturn;
  Field: TField;
  Obj: TObject;
  TempNewNode: TSourceNode;
  ListValue: TSourceNodeList<TSourceNode>;
begin
  NewNode := nil;
  if (ofReplaceRepeatUntilByWhileDo in Features) and (SourceNode is TRepeatUntil) then begin
    WhileDo := TWhileDo.Create;
    WhileDo.Command := TBeginEnd.Create;
    WhileDo.Parent := TRepeatUntil(SourceNode).Parent;
    TBeginEnd(WhileDo.Command).Commands := TRepeatUntil(SourceNode).Commands;
    TBeginEnd(WhileDo.Command).Parent := WhileDo;
    TRepeatUntil(SourceNode).Commands := TCommands.Create;
    WhileDo.Expression := TExpressionOperand.Create;
    WhileDo.Expression.Parent := WhileDo;
    TExpressionOperand(WhileDo.Expression).OperandType := otConstantDirect;
    TExpressionOperand(WhileDo.Expression).ConstantDirect := TConstant.Create;
    TConstant(TExpressionOperand(WhileDo.Expression).ConstantDirect).Value := TValueBoolean.Create;
    TValueBoolean(TConstant(TExpressionOperand(WhileDo.Expression).ConstantDirect).Value).Value := True;

    // Add final if
    Condition := TIfThenElse.Create;
    Condition.Parent := WhileDo;
    Condition.Expression := TRepeatUntil(SourceNode).Expression;
    Condition.CommandThen := TBreak.Create;
    Condition.CommandThen.Parent := Condition;
    TRepeatUntil(SourceNode).Expression := TExpression.Create;
    TBeginEnd(WhileDo.Command).Commands.Add(Condition);
    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
      Field := SourceNode.GetField(I);
      if Field.DataType = dtObject then begin
        SourceNode.GetValue(I, Obj);
        if Obj is TSourceNode then begin
          OptimizeNode(TSourceNode(Obj), TempNewNode);
          if Assigned(TempNewNode) and (TempNewNode <> TSourceNode(Obj)) then begin
            SourceNode.SetValueObject(I, TempNewNode);
          end;
        end;
      end;
      Field.Free;
    end;
  end else
    raise Exception.Create(SUnsupportedNodeType);

  for I := 0 to SourceNode.FieldsCount - 1 do begin
    Field := SourceNode.GetField(I);
    if Field.DataType = dtList then begin
      SourceNode.GetValue(I, ListValue);
      OptimizeNodes(TSourceNodeList<TSourceNode>(ListValue), NewNode)
    end;
  end;
end;

procedure TOptimizer.Optimize;
var
  NewProg: TSourceNode;
begin
  OptimizeNode(Prog, NewProg);
end;

end.