source: trunk/Compiler/Modules/Interpretter/ModuleInterpretter.pas

unit ModuleInterpretter;

interface

uses
  Classes, SysUtils, Target, Executor, SourceCodePascal, Dialogs,
  Generics.Collections, ModularSystem;

type
  { TExecutorInterpretter }

  TExecutorInterpretter = class(TExecutor)
  private
    //procedure SystemAdd(FunctionCall: TFunctionCall);
    //procedure SystemSub(FunctionCall: TFunctionCall);
    //procedure SystemMove(FunctionCall: TFunctionCall);
    //procedure SystemFillChar(FunctionCall: TFunctionCall);

    procedure RunCommand(Command: TCommand);
    procedure RunBeginEnd(BeginEnd: TBeginEnd);
    procedure RunWhileDo(WhileDo: TWhileDo);
    procedure RunRepeatUntil(RepeatUntil: TRepeatUntil);
    procedure RunIfThenElse(IfThenElse: TIfThenElse);
    procedure RunAssignment(Assignment: TAssignment);
    procedure RunCaseOfEnd(CaseOfEnd: TCaseOfEnd);
    function RunFunction(FunctionCall: TFunctionCall): TValue;
    procedure RunForToDo(ForToDo: TForToDo);
    function Evaluate(Expression: TExpression): TValue;
  public
    Variables: TObjectList<TVariable>;
    procedure Run; override;
    constructor Create;
    destructor Destroy; override;
  end;

  { TModuleInterpretter }

  TModuleInterpretter = class(TModule)
    constructor Create(AOwner: TComponent); override;
    procedure DoInstall; override;
    procedure DoUninstall; override;
  end;

implementation

uses
  Compiler, CompilerAPI;

resourcestring
  SUnknownCommandType = 'Unknown command type';
  SUnknownOperator = 'Unknown operator "%s"';

{ TModuleInterpretter }

constructor TModuleInterpretter.Create(AOwner: TComponent);
begin
  inherited;
  Identification := 'Interpretter';
  Title := 'Interpretter';
  Version := '0.1';
  Dependencies.Add('Pascal');
end;

procedure TModuleInterpretter.DoInstall;
begin
  inherited;
  //TCompilerAPI(API).RegisterConvertor(TCovertor);
end;

procedure TModuleInterpretter.DoUninstall;
begin
  inherited;
end;

{ TExecutorInterpretter }

procedure TExecutorInterpretter.RunCommand(Command: TCommand);
begin
  if Command is TBeginEnd then RunBeginEnd(TBeginEnd(Command))
  else if Command is TWhileDo then RunWhileDo(TWhileDo(Command))
  else if Command is TRepeatUntil then RunRepeatUntil(TRepeatUntil(Command))
  else if Command is TIfThenElse then RunIfThenElse(TIfThenElse(Command))
  else if Command is TAssignment then RunAssignment(TAssignment(Command))
  else if Command is TCaseOfEnd then RunCaseOfEnd(TCaseOfEnd(Command))
  else if Command is TFunctionCall then RunFunction(TFunctionCall(Command))
  else if Command is TForToDo then RunForToDo(TForToDo(Command))
  else raise Exception.Create(SUnknownCommandType);
end;

procedure TExecutorInterpretter.RunBeginEnd(BeginEnd: TBeginEnd);
var
  I: Integer;
begin
  for I := 0 to BeginEnd.Commands.Count - 1 do
    RunCommand(TCommand(BeginEnd.Commands[I]))
end;

procedure TExecutorInterpretter.RunWhileDo(WhileDo: TWhileDo);
begin
  while Evaluate(WhileDo.Condition) do RunBeginEnd(WhileDo.CommonBlock.Code);
end;

procedure TExecutorInterpretter.RunRepeatUntil(RepeatUntil: TRepeatUntil);
begin
  repeat
    RunBeginEnd(RepeatUntil.CommonBlock.Code);
  until Evaluate(RepeatUntil.Condition);
end;

procedure TExecutorInterpretter.RunIfThenElse(IfThenElse: TIfThenElse);
begin
  if Evaluate(IfThenElse.Condition) then RunCommand(IfThenElse.Command)
    else RunCommand(IfThenElse.ElseCommand);
end;

procedure TExecutorInterpretter.RunAssignment(Assignment: TAssignment);
begin
  Assignment.Target.Value := Evaluate(Assignment.Source);
end;

procedure TExecutorInterpretter.RunCaseOfEnd(CaseOfEnd: TCaseOfEnd);
var
  I: Integer;
begin
 (* I := 0;
  while (I < CaseOfEnd.Branches.Count) and
    if TCaseOfEndBranche(CaseOfEnd.Branches[I]).Constant =
      Evaluate(CaseOfEnd.Expression) do
      Inc(I);
  if (I < CaseOfEnd.Branches.Count) then
    RunCommand(TCaseOfEndBranche(CaseOfEnd.Branches[I]).Command)
    else RunCommand(CaseOfEnd.ElseCommand); *)
end;

function TExecutorInterpretter.RunFunction(FunctionCall: TFunctionCall): TValue;
begin
  RunBeginEnd(FunctionCall.FunctionRef.Code);
end;

procedure TExecutorInterpretter.RunForToDo(ForToDo: TForToDo);
var
  I: Integer;
begin
(*  for I := 0 to ForToDo.Start to ForToDo.Stop do begin
    ForToDo.ControlVariable.;
    RunCommand(ForToDo.Command);
  end; *)
end;

function TExecutorInterpretter.Evaluate(Expression: TExpression): TValue;
var
  I: Integer;
begin
  with Expression do
  case NodeType of
    ntConstant: Result := Constant.Value;
    ntFunction: Result := RunFunction(FunctionCall);
    ntOperator: begin
      if OperatorName = '>' then
        Result := Evaluate(TExpression(SubItems.First)) > Evaluate(TExpression(SubItems.Last))
      else if OperatorName = '<' then
        Result := Evaluate(TExpression(SubItems.First)) < Evaluate(TExpression(SubItems.Last))
      else if OperatorName = '+' then
        Result := Evaluate(TExpression(SubItems.First)) + Evaluate(TExpression(SubItems.Last))
      else if OperatorName = '-' then
        Result := Evaluate(TExpression(SubItems.First)) - Evaluate(TExpression(SubItems.Last))
      else if OperatorName = '*' then
        Result := Evaluate(TExpression(SubItems.First)) * Evaluate(TExpression(SubItems.Last))
      else if OperatorName = 'div' then
        Result := Evaluate(TExpression(SubItems.First)) div Evaluate(TExpression(SubItems.Last))
        else raise Exception.CreateFmt(SUnknownOperator, [OperatorName]);
    end;
    ntVariable: Result := Variable.Value;
    ntValue: Result := Value;
  end;
end;

procedure TExecutorInterpretter.Run;
begin
  with TModuleProgram(TCompiler(TTarget(Target).Compiler).Analyzer.ProgramCode.MainModule) do begin
    RunBeginEnd(Body.Code);
  end;
end;

constructor TExecutorInterpretter.Create;
begin
  Variables := TVariables.Create;
end;

destructor TExecutorInterpretter.Destroy;
begin
  FreeAndnil(Variables);
  inherited;
end;

end.