source: branches/xpascal/Executor.pas

unit Executor;

interface

uses
  Classes, SysUtils, Source, Generics.Collections;

type
  TExecutorFunctions = class;
  TExecutorBlock = class;

  TExecutorVariableKind = (vkNormal, vkReference);

  { TExecutorVariable }

  TExecutorVariable = class
  private
    FValue: TValue;
    function GetValue: TValue;
    procedure SetValue(AValue: TValue);
  public
    Variable: TVariable;
    Kind: TExecutorVariableKind;
    RefVariable: TExecutorVariable;
    constructor Create;
    destructor Destroy; override;
    property Value: TValue read GetValue write SetValue;
  end;

  { TExecutorVariables }

  TExecutorVariables = class(TObjectList<TExecutorVariable>)
    function SearchByVariable(Variable: TVariable): TExecutorVariable;
    function AddNew(Variable: TVariable): TExecutorVariable;
  end;

  { TExecutorType }

  TExecutorType = class
    TypeRef: TType;
    Functions: TExecutorFunctions;
    constructor Create;
    destructor Destroy; override;
  end;

  { TExecutorTypes }

  TExecutorTypes = class(TObjectList<TExecutorType>)
    function SearchByType(TypeRef: TType): TExecutorType;
    function AddNew(TypeRef: TType): TExecutorType;
  end;

  TExecutorFunctionCallback = function(Params: array of TExecutorVariable):
    TValue of object;

  { TExecutorFunction }

  TExecutorFunction = class
    FunctionDef: TFunction;
    Block: TExecutorBlock;
    Callback: TExecutorFunctionCallback;
    constructor Create;
    destructor Destroy; override;
  end;

  { TExecutorFunctions }

  TExecutorFunctions = class(TObjectList<TExecutorFunction>)
    function SearchByFunction(FunctionDef: TFunction): TExecutorFunction;
    function AddNew(FunctionDef: TFunction): TExecutorFunction;
  end;

  { TExecutorProcedure }

  TExecutorProcedure = class
    ProcedureDef: TProcedure;
    Block: TExecutorBlock;
    Callback: TExecutorFunctionCallback;
    constructor Create;
    destructor Destroy; override;
  end;

  { TExecutorProcedures }

  TExecutorProcedures = class(TObjectList<TExecutorProcedure>)
    function SearchByProcedure(ProcedureDef: TProcedure): TExecutorProcedure;
    function AddNew(ProcedureDef: TProcedure): TExecutorProcedure;
  end;

  { TExecutorBlock }

  TExecutorBlock = class
    Parent: TExecutorBlock;
    Types: TExecutorTypes;
    Variables: TExecutorVariables;
    Functions: TExecutorFunctions;
    Procedures: TExecutorProcedures;
    function GetFunction(FunctionDef: TFunction): TExecutorFunction;
    function GetProcedure(ProcedureDef: TProcedure): TExecutorProcedure;
    function GetType(TypeDef: TType): TExecutorType;
    function GetVariable(Variable: TVariable): TExecutorVariable;
    function GetTypeFunction(TypeDef: TType; FunctionDef: TFunction): TExecutorFunction; overload;
    function GetTypeFunction(TypeDef: TType; FunctionName: string): TExecutorFunction; overload;
    constructor Create;
    destructor Destroy; override;
  end;

  TOutputEvent = procedure (Text: string) of object;
  TInputEvent = function: string of object;

  { TExecutor }

  TExecutor = class
  private
    FOnOutput: TOutputEvent;
    FOnInput: TInputEvent;
    SystemBlock: TExecutorBlock;
    function ExecuteWriteLn(Params: array of TExecutorVariable): TValue;
    function ExecuteWrite(Params: array of TExecutorVariable): TValue;
    function ExecuteReadLn(Params: array of TExecutorVariable): TValue;
    function ExecuteRead(Params: array of TExecutorVariable): TValue;
    function ExecuteIntToStr(Params: array of TExecutorVariable): TValue;
    function ExecuteStrToInt(Params: array of TExecutorVariable): TValue;
    function ExecuteBoolToStr(Params: array of TExecutorVariable): TValue;
    function ExecuteStrToBool(Params: array of TExecutorVariable): TValue;
    function ExecuteBooleanAssign(Params: array of TExecutorVariable): TValue;
    function ExecuteBooleanNot(Params: array of TExecutorVariable): TValue;
    function ExecuteBooleanEqual(Params: array of TExecutorVariable): TValue;
    function ExecuteBooleanNotEqual(Params: array of TExecutorVariable): TValue;
    function ExecuteStringAssign(Params: array of TExecutorVariable): TValue;
    function ExecuteStringAdd(Params: array of TExecutorVariable): TValue;
    function ExecuteStringEqual(Params: array of TExecutorVariable): TValue;
    function ExecuteStringNotEqual(Params: array of TExecutorVariable): TValue;
    function ExecuteIntegerAssign(Params: array of TExecutorVariable): TValue;
    function ExecuteIntegerAdd(Params: array of TExecutorVariable): TValue;
    function ExecuteIntegerSub(Params: array of TExecutorVariable): TValue;
    function ExecuteIntegerMul(Params: array of TExecutorVariable): TValue;
    function ExecuteIntegerIntDiv(Params: array of TExecutorVariable): TValue;
    function ExecuteIntegerMod(Params: array of TExecutorVariable): TValue;
    function ExecuteIntegerEqual(Params: array of TExecutorVariable): TValue;
    function ExecuteIntegerNotEqual(Params: array of TExecutorVariable): TValue;
    function ExecuteIntegerLesser(Params: array of TExecutorVariable): TValue;
    function ExecuteIntegerHigher(Params: array of TExecutorVariable): TValue;
    function ExecuteIntegerLesserOrEqual(Params: array of TExecutorVariable): TValue;
    function ExecuteIntegerHigherOrEqual(Params: array of TExecutorVariable): TValue;
    function ExecuteIntegerAnd(Params: array of TExecutorVariable): TValue;
    function ExecuteIntegerOr(Params: array of TExecutorVariable): TValue;
    function ExecuteIntegerXor(Params: array of TExecutorVariable): TValue;
    function ExecuteIntegerShr(Params: array of TExecutorVariable): TValue;
    function ExecuteIntegerShl(Params: array of TExecutorVariable): TValue;
    procedure InitExecutorBlock(ExecutorBlock: TExecutorBlock; Block: TBlock);
  public
    Prog: TProgram;
    procedure ExecuteProgram(Prog: TProgram);
    procedure ExecuteBeginEnd(Block: TExecutorBlock; BeginEnd: TBeginEnd);
    procedure ExecuteCommand(Block: TExecutorBlock; Command: TCommand);
    procedure ExecuteIfThenElse(Block: TExecutorBlock; IfThenElse: TIfThenElse);
    procedure ExecuteWhileDo(Block: TExecutorBlock; WhileDo: TWhileDo);
    procedure ExecuteRepeatUntil(Block: TExecutorBlock; RepeatUntil: TRepeatUntil);
    procedure ExecuteForToDo(Block: TExecutorBlock; ForToDo: TForToDo);
    procedure ExecuteContinue(Block: TExecutorBlock; ContinueCmd: TContinue);
    procedure ExecuteBreak(Block: TExecutorBlock; BreakCmd: TBreak);
    procedure ExecuteBlock(ParentBlock: TExecutorBlock; Block: TBlock; ExistingBlock: TExecutorBlock = nil);
    function ExecuteFunctionCall(Block: TExecutorBlock; FunctionCall: TFunctionCall): TValue;
    procedure ExecuteProcedureCall(Block: TExecutorBlock; ProcedureCall: TProcedureCall);
    procedure ExecuteAssignment(Block: TExecutorBlock; Assignment: TAssignment);
    function ExecuteExpression(Block: TExecutorBlock; Expression: TExpression): TValue;
    function ExecuteExpressionOperation(Block: TExecutorBlock; Expression: TExpressionOperation): TValue;
    function ExecuteExpressionOperand(Block: TExecutorBlock; Expression: TExpressionOperand): TValue;
    function ExecuteExpressionBrackets(Block: TExecutorBlock; Expression: TExpressionBrackets): TValue;
    procedure Run;
    procedure Output(Text: string);
    function Input: string;
    property OnOutput: TOutputEvent read FOnOutput write FOnOutput;
    property OnInput: TInputEvent read FOnInput write FOnInput;
  end;


implementation

uses
  SourceNode;

resourcestring
  SUnsupportedOperandType = 'Unsupported exception operand type.';
  SUnsupportedCommandType = 'Unsupported command type.';
  SExpectedBooleanValue = 'Expected boolean value.';

{ TExecutorProcedures }

function TExecutorProcedures.SearchByProcedure(ProcedureDef: TProcedure
  ): TExecutorProcedure;
var
  I: Integer;
begin
  I := 0;
  while (I < Count) and (Items[I].ProcedureDef <> ProcedureDef) do Inc(I);
  if I < Count then Result := Items[I]
    else Result := nil;
end;

function TExecutorProcedures.AddNew(ProcedureDef: TProcedure
  ): TExecutorProcedure;
begin
  Result := TExecutorProcedure.Create;
  Result.ProcedureDef := ProcedureDef;
  Add(Result);
end;

{ TExecutorProcedure }

constructor TExecutorProcedure.Create;
begin
  Block := TExecutorBlock.Create;
end;

destructor TExecutorProcedure.Destroy;
begin
  FreeAndNil(Block);
  inherited;
end;

{ TExecutorFunction }

constructor TExecutorFunction.Create;
begin
  Block := TExecutorBlock.Create;
end;

destructor TExecutorFunction.Destroy;
begin
  FreeAndNil(Block);
  inherited;
end;

{ TExecutorVariable }

procedure TExecutorVariable.SetValue(AValue: TValue);
begin
  if FValue = AValue then Exit;
  if Kind = vkNormal then begin
    FreeAndNil(FValue);
    FValue := AValue;
  end else
  if Kind = vkReference then begin
    RefVariable.Value := AValue;
  end;
end;

function TExecutorVariable.GetValue: TValue;
begin
  if Kind = vkNormal then begin
    Result := FValue;
  end else
  if Kind = vkReference then begin
    Result := RefVariable.Value;
  end;
end;

constructor TExecutorVariable.Create;
begin
  Value := TValue.Create;
end;

destructor TExecutorVariable.Destroy;
begin
  FreeAndNil(FValue);
  inherited;
end;

{ TExecutorType }

constructor TExecutorType.Create;
begin
  Functions := TExecutorFunctions.Create;
end;

destructor TExecutorType.Destroy;
begin
  FreeAndNil(Functions);
  inherited;
end;

{ TExecutorTypes }

function TExecutorTypes.SearchByType(TypeRef: TType): TExecutorType;
var
  I: Integer;
begin
  I := 0;
  while (I < Count) and (Items[I].TypeRef <> TypeRef) do Inc(I);
  if I < Count then Result := Items[I]
    else Result := nil;
end;

function TExecutorTypes.AddNew(TypeRef: TType): TExecutorType;
begin
  Result := TExecutorType.Create;
  Result.TypeRef := TypeRef;
  Add(Result);
end;

{ TExecutorFunctions }

function TExecutorFunctions.SearchByFunction(FunctionDef: TFunction
  ): TExecutorFunction;
var
  I: Integer;
begin
  I := 0;
  while (I < Count) and (Items[I].FunctionDef <> FunctionDef) do Inc(I);
  if I < Count then Result := Items[I]
    else Result := nil;
end;

function TExecutorFunctions.AddNew(FunctionDef: TFunction): TExecutorFunction;
begin
  Result := TExecutorFunction.Create;
  Result.FunctionDef := FunctionDef;
  Add(Result);
end;

{ TExecutorVariables }

function TExecutorVariables.SearchByVariable(Variable: TVariable): TExecutorVariable;
var
  I: Integer;
begin
  I := 0;
  while (I < Count) and (Items[I].Variable <> Variable) do Inc(I);
  if I < Count then Result := Items[I]
    else Result := nil;
end;

function TExecutorVariables.AddNew(Variable: TVariable): TExecutorVariable;
begin
  Result := TExecutorVariable.Create;
  Result.Variable := Variable;
  Add(Result);
end;

{ TExecutorBlock }

function TExecutorBlock.GetFunction(FunctionDef: TFunction): TExecutorFunction;
begin
  Result := Functions.SearchByFunction(FunctionDef);
  if not Assigned(Result) and Assigned(Parent) then
    Result := Parent.GetFunction(FunctionDef);
end;

function TExecutorBlock.GetProcedure(ProcedureDef: TProcedure
  ): TExecutorProcedure;
begin
  Result := Procedures.SearchByProcedure(ProcedureDef);
  if not Assigned(Result) and Assigned(Parent) then
    Result := Parent.GetProcedure(ProcedureDef);
end;

function TExecutorBlock.GetType(TypeDef: TType): TExecutorType;
begin
  Result := Types.SearchByType(TypeDef);
  if not Assigned(Result) and Assigned(Parent) then
    Result := Parent.GetType(TypeDef);
end;

function TExecutorBlock.GetVariable(Variable: TVariable): TExecutorVariable;
begin
  Result := Variables.SearchByVariable(Variable);
  if not Assigned(Result) and Assigned(Parent) then
    Result := Parent.GetVariable(Variable);
end;

function TExecutorBlock.GetTypeFunction(TypeDef: TType; FunctionDef: TFunction
  ): TExecutorFunction;
var
  ExecutorType: TExecutorType;
begin
  ExecutorType := GetType(TypeDef);
  Result := ExecutorType.Functions.SearchByFunction(FunctionDef);
end;

function TExecutorBlock.GetTypeFunction(TypeDef: TType; FunctionName: string
  ): TExecutorFunction;
begin
  Result := GetTypeFunction(TypeDef, TypeDef.Functions.SearchByName(FunctionName));
end;

constructor TExecutorBlock.Create;
begin
  Types := TExecutorTypes.Create;
  Variables := TExecutorVariables.Create;
  Functions := TExecutorFunctions.Create;
  Procedures := TExecutorProcedures.Create;
end;

destructor TExecutorBlock.Destroy;
begin
  FreeAndNil(Variables);
  FreeAndNil(Functions);
  FreeAndNil(Procedures);
  FreeAndNil(Types);
  inherited;
end;

{ TExecutor }

function TExecutor.ExecuteWriteLn(Params: array of TExecutorVariable): TValue;
var
  I: Integer;
  Text: string;
begin
  Result := nil;
  Text := '';
  for I := 0 to Length(Params) - 1 do
    Text := Text + TValueString(Params[I].Value).Value;
  Output(Text + LineEnding);
end;

function TExecutor.ExecuteWrite(Params: array of TExecutorVariable): TValue;
var
  I: Integer;
  Text: string;
begin
  Result := nil;
  Text := '';
  for I := 0 to Length(Params) - 1 do
    Text := Text + TValueString(Params[I].Value).Value;
  Output(Text);
end;

function TExecutor.ExecuteReadLn(Params: array of TExecutorVariable): TValue;
var
  I: Integer;
begin
  Result := nil;
  for I := 0 to Length(Params) - 1 do begin
    TValueString(Params[I].Value).Value := Input;
  end;
  Output(LineEnding);
end;

function TExecutor.ExecuteRead(Params: array of TExecutorVariable): TValue;
var
  I: Integer;
begin
  Result := nil;
  for I := 0 to Length(Params) - 1 do
    TValueString(Params[I].Value).Value := Input;
end;

function TExecutor.ExecuteIntToStr(Params: array of TExecutorVariable): TValue;
begin
  Result := TValueString.Create;
  TValueString(Result).Value := IntToStr(TValueInteger(Params[0].Value).Value);
end;

function TExecutor.ExecuteStrToInt(Params: array of TExecutorVariable): TValue;
begin
  Result := TValueInteger.Create;
  TValueInteger(Result).Value := StrToInt(TValueString(Params[0].Value).Value);
end;

function TExecutor.ExecuteBoolToStr(Params: array of TExecutorVariable): TValue;
begin
  Result := TValueString.Create;
  TValueString(Result).Value := BoolToStr(TValueBoolean(Params[0].Value).Value);
end;

function TExecutor.ExecuteStrToBool(Params: array of TExecutorVariable): TValue;
begin
  Result := TValueBoolean.Create;
  TValueBoolean(Result).Value := StrToBool(TValueString(Params[0].Value).Value);
end;

function TExecutor.ExecuteBooleanAssign(Params: array of TExecutorVariable): TValue;
begin
  Result := TValueBoolean.Create;
  TValueBoolean(Result).Value := TValueBoolean(Params[0].Value).Value;
end;

function TExecutor.ExecuteBooleanNot(Params: array of TExecutorVariable): TValue;
begin
  Result := TValueBoolean.Create;
  TValueBoolean(Result).Value := not TValueBoolean(Params[0].Value).Value;
end;

function TExecutor.ExecuteBooleanEqual(Params: array of TExecutorVariable): TValue;
begin
  Result := TValueBoolean.Create;
  TValueBoolean(Result).Value := TValueBoolean(Params[0].Value).Value =
    TValueBoolean(Params[1].Value).Value;
end;

function TExecutor.ExecuteBooleanNotEqual(Params: array of TExecutorVariable): TValue;
begin
  Result := TValueBoolean.Create;
  TValueBoolean(Result).Value := TValueBoolean(Params[0].Value).Value <>
    TValueBoolean(Params[1].Value).Value;
end;

function TExecutor.ExecuteStringAssign(Params: array of TExecutorVariable): TValue;
begin
  Result := TValueString.Create;
  TValueString(Result).Value := TValueString(Params[0].Value).Value;
end;

function TExecutor.ExecuteStringAdd(Params: array of TExecutorVariable): TValue;
begin
  Result := TValueString.Create;
  TValueString(Result).Value := TValueString(Params[0].Value).Value +
    TValueString(Params[1].Value).Value;
end;

function TExecutor.ExecuteStringEqual(Params: array of TExecutorVariable): TValue;
begin
  Result := TValueBoolean.Create;
  TValueBoolean(Result).Value := TValueString(Params[0].Value).Value =
    TValueString(Params[1].Value).Value;
end;

function TExecutor.ExecuteStringNotEqual(Params: array of TExecutorVariable): TValue;
begin
  Result := TValueBoolean.Create;
  TValueBoolean(Result).Value := TValueString(Params[0].Value).Value <>
    TValueString(Params[1].Value).Value;
end;

function TExecutor.ExecuteIntegerAssign(Params: array of TExecutorVariable): TValue;
begin
  Result := TValueInteger.Create;
  TValueInteger(Result).Value := TValueInteger(Params[0].Value).Value;
end;

function TExecutor.ExecuteIntegerAdd(Params: array of TExecutorVariable): TValue;
begin
  Result := TValueInteger.Create;
  TValueInteger(Result).Value := TValueInteger(Params[0].Value).Value +
    TValueInteger(Params[1].Value).Value;
end;

function TExecutor.ExecuteIntegerSub(Params: array of TExecutorVariable): TValue;
begin
  Result := TValueInteger.Create;
  TValueInteger(Result).Value := TValueInteger(Params[0].Value).Value -
    TValueInteger(Params[1].Value).Value;
end;

function TExecutor.ExecuteIntegerMul(Params: array of TExecutorVariable): TValue;
begin
  Result := TValueInteger.Create;
  TValueInteger(Result).Value := TValueInteger(Params[0].Value).Value *
    TValueInteger(Params[1].Value).Value;
end;

function TExecutor.ExecuteIntegerIntDiv(Params: array of TExecutorVariable): TValue;
begin
  Result := TValueInteger.Create;
  TValueInteger(Result).Value := TValueInteger(Params[0].Value).Value div
    TValueInteger(Params[1].Value).Value;
end;

function TExecutor.ExecuteIntegerMod(Params: array of TExecutorVariable): TValue;
begin
  Result := TValueInteger.Create;
  TValueInteger(Result).Value := TValueInteger(Params[0].Value).Value mod
    TValueInteger(Params[1].Value).Value;
end;

function TExecutor.ExecuteIntegerEqual(Params: array of TExecutorVariable): TValue;
begin
  Result := TValueBoolean.Create;
  TValueBoolean(Result).Value := TValueInteger(Params[0].Value).Value =
    TValueInteger(Params[1].Value).Value;
end;

function TExecutor.ExecuteIntegerNotEqual(Params: array of TExecutorVariable): TValue;
begin
  Result := TValueBoolean.Create;
  TValueBoolean(Result).Value := TValueInteger(Params[0].Value).Value <>
    TValueInteger(Params[1].Value).Value;
end;

function TExecutor.ExecuteIntegerLesser(Params: array of TExecutorVariable): TValue;
begin
  Result := TValueBoolean.Create;
  TValueBoolean(Result).Value := TValueInteger(Params[0].Value).Value <
    TValueInteger(Params[1].Value).Value;
end;

function TExecutor.ExecuteIntegerHigher(Params: array of TExecutorVariable): TValue;
begin
  Result := TValueBoolean.Create;
  TValueBoolean(Result).Value := TValueInteger(Params[0].Value).Value >
    TValueInteger(Params[1].Value).Value;
end;

function TExecutor.ExecuteIntegerLesserOrEqual(Params: array of TExecutorVariable): TValue;
begin
  Result := TValueBoolean.Create;
  TValueBoolean(Result).Value := TValueInteger(Params[0].Value).Value <=
    TValueInteger(Params[1].Value).Value;
end;

function TExecutor.ExecuteIntegerHigherOrEqual(Params: array of TExecutorVariable): TValue;
begin
  Result := TValueBoolean.Create;
  TValueBoolean(Result).Value := TValueInteger(Params[0].Value).Value >=
    TValueInteger(Params[1].Value).Value;
end;

function TExecutor.ExecuteIntegerAnd(Params: array of TExecutorVariable): TValue;
begin
  Result := TValueInteger.Create;
  TValueInteger(Result).Value := TValueInteger(Params[0].Value).Value and
    TValueInteger(Params[1].Value).Value;
end;

function TExecutor.ExecuteIntegerOr(Params: array of TExecutorVariable): TValue;
begin
  Result := TValueInteger.Create;
  TValueInteger(Result).Value := TValueInteger(Params[0].Value).Value or
    TValueInteger(Params[1].Value).Value;
end;

function TExecutor.ExecuteIntegerXor(Params: array of TExecutorVariable): TValue;
begin
  Result := TValueInteger.Create;
  TValueInteger(Result).Value := TValueInteger(Params[0].Value).Value xor
    TValueInteger(Params[1].Value).Value;
end;

function TExecutor.ExecuteIntegerShr(Params: array of TExecutorVariable): TValue;
begin
  Result := TValueInteger.Create;
  TValueInteger(Result).Value := TValueInteger(Params[0].Value).Value shr
    TValueInteger(Params[1].Value).Value;
end;

function TExecutor.ExecuteIntegerShl(Params: array of TExecutorVariable): TValue;
begin
  Result := TValueInteger.Create;
  TValueInteger(Result).Value := TValueInteger(Params[0].Value).Value shl
    TValueInteger(Params[1].Value).Value;
end;

procedure TExecutor.InitExecutorBlock(ExecutorBlock: TExecutorBlock; Block: TBlock);
var
  I: Integer;
  J: Integer;
  ExecutorFunction: TExecutorFunction;
  ExecutorProcedure: TExecutorProcedure;
  ExecutorType: TExecutorType;
begin
  for I := 0 to Block.Types.Count - 1 do begin
    ExecutorType := ExecutorBlock.Types.AddNew(TType(Block.Types[I]));
    for J := 0 to ExecutorType.TypeRef.Functions.Count - 1 do begin
      ExecutorFunction := ExecutorType.Functions.AddNew(TFunction(ExecutorType.TypeRef.Functions[J]));
      if ExecutorType.TypeRef.Name = 'Boolean' then begin
        if ExecutorFunction.FunctionDef.Name = '_Assign' then begin
          ExecutorFunction.Callback := ExecuteBooleanAssign;
        end else
        if ExecutorFunction.FunctionDef.Name = '_Equal' then begin
          ExecutorFunction.Callback := ExecuteBooleanEqual;
        end;
        if ExecutorFunction.FunctionDef.Name = '_NotEqual' then begin
          ExecutorFunction.Callback := ExecuteBooleanNotEqual;
        end;
        if ExecutorFunction.FunctionDef.Name = '_Not' then begin
          ExecutorFunction.Callback := ExecuteBooleanNot;
        end else
      end else
      if ExecutorType.TypeRef.Name = 'string' then begin
        if ExecutorFunction.FunctionDef.Name = '_Assign' then begin
          ExecutorFunction.Callback := ExecuteStringAssign;
        end else
        if ExecutorFunction.FunctionDef.Name = '_Add' then begin
          ExecutorFunction.Callback := ExecuteStringAdd;
        end else
        if ExecutorFunction.FunctionDef.Name = '_Equal' then begin
          ExecutorFunction.Callback := ExecuteStringEqual;
        end;
        if ExecutorFunction.FunctionDef.Name = '_NotEqual' then begin
          ExecutorFunction.Callback := ExecuteStringNotEqual;
        end;
      end else
      if ExecutorType.TypeRef.Name = 'Integer' then begin
        if ExecutorFunction.FunctionDef.Name = '_Assign' then begin
          ExecutorFunction.Callback := ExecuteIntegerAssign;
        end else
        if ExecutorFunction.FunctionDef.Name = '_Add' then begin
          ExecutorFunction.Callback := ExecuteIntegerAdd;
        end else
        if ExecutorFunction.FunctionDef.Name = '_Sub' then begin
          ExecutorFunction.Callback := ExecuteIntegerSub;
        end else
        if ExecutorFunction.FunctionDef.Name = '_Mul' then begin
          ExecutorFunction.Callback := ExecuteIntegerMul;
        end else
        if ExecutorFunction.FunctionDef.Name = '_IntDiv' then begin
          ExecutorFunction.Callback := ExecuteIntegerIntDiv;
        end else
        if ExecutorFunction.FunctionDef.Name = '_IntMod' then begin
          ExecutorFunction.Callback := ExecuteIntegerMod;
        end else
        if ExecutorFunction.FunctionDef.Name = '_Equal' then begin
          ExecutorFunction.Callback := ExecuteIntegerEqual;
        end else
        if ExecutorFunction.FunctionDef.Name = '_NotEqual' then begin
          ExecutorFunction.Callback := ExecuteIntegerNotEqual;
        end;
        if ExecutorFunction.FunctionDef.Name = '_Lesser' then begin
          ExecutorFunction.Callback := ExecuteIntegerLesser;
        end else
        if ExecutorFunction.FunctionDef.Name = '_Higher' then begin
          ExecutorFunction.Callback := ExecuteIntegerHigher;
        end;
        if ExecutorFunction.FunctionDef.Name = '_LesserOrEqual' then begin
          ExecutorFunction.Callback := ExecuteIntegerLesserOrEqual;
        end else
        if ExecutorFunction.FunctionDef.Name = '_HigherOrEqual' then begin
          ExecutorFunction.Callback := ExecuteIntegerHigherOrEqual;
        end;
        if ExecutorFunction.FunctionDef.Name = '_And' then begin
          ExecutorFunction.Callback := ExecuteIntegerAnd;
        end;
        if ExecutorFunction.FunctionDef.Name = '_Or' then begin
          ExecutorFunction.Callback := ExecuteIntegerOr;
        end;
        if ExecutorFunction.FunctionDef.Name = '_Xor' then begin
          ExecutorFunction.Callback := ExecuteIntegerXor;
        end;
        if ExecutorFunction.FunctionDef.Name = '_Shr' then begin
          ExecutorFunction.Callback := ExecuteIntegerShr;
        end;
        if ExecutorFunction.FunctionDef.Name = '_Shl' then begin
          ExecutorFunction.Callback := ExecuteIntegerShl;
        end;
      end;
    end;
  end;

  for I := 0 to Block.Variables.Count - 1 do begin
    ExecutorBlock.Variables.AddNew(TVariable(Block.Variables[I]));
  end;

  for I := 0 to Block.Functions.Count - 1 do begin
    ExecutorFunction := ExecutorBlock.Functions.AddNew(TFunction(Block.Functions[I]));
    if ExecutorFunction.FunctionDef.Name = 'IntToStr' then begin
      ExecutorFunction.Callback := ExecuteIntToStr;
    end else
    if ExecutorFunction.FunctionDef.Name = 'StrToInt' then begin
      ExecutorFunction.Callback := ExecuteStrToInt;
    end else
    if ExecutorFunction.FunctionDef.Name = 'BoolToStr' then begin
      ExecutorFunction.Callback := ExecuteBoolToStr;
    end else
    if ExecutorFunction.FunctionDef.Name = 'StrToBool' then begin
      ExecutorFunction.Callback := ExecuteStrToBool;
    end;
  end;

  for I := 0 to Block.Procedures.Count - 1 do begin
    ExecutorProcedure := ExecutorBlock.Procedures.AddNew(TProcedure(Block.Procedures[I]));
    if ExecutorProcedure.ProcedureDef.Name = 'Write' then begin
      ExecutorProcedure.Callback := ExecuteWrite;
    end else
    if ExecutorProcedure.ProcedureDef.Name = 'WriteLn' then begin
      ExecutorProcedure.Callback := ExecuteWriteLn;
    end else
    if ExecutorProcedure.ProcedureDef.Name = 'Read' then begin
      ExecutorProcedure.Callback := ExecuteRead;
    end else
    if ExecutorProcedure.ProcedureDef.Name = 'ReadLn' then begin
      ExecutorProcedure.Callback := ExecuteReadLn;
    end;
  end;
end;

procedure TExecutor.ExecuteProgram(Prog: TProgram);
begin
  SystemBlock := TExecutorBlock.Create;
  InitExecutorBlock(SystemBlock, Prog.SystemBlock);
  ExecuteBlock(SystemBlock, Prog.Block);
  SystemBlock.Free;
end;

procedure TExecutor.ExecuteBeginEnd(Block: TExecutorBlock; BeginEnd: TBeginEnd);
var
  I: Integer;
begin
  for I := 0 to BeginEnd.Commands.Count - 1 do
    ExecuteCommand(Block, BeginEnd.Commands[I]);
end;

procedure TExecutor.ExecuteCommand(Block: TExecutorBlock; Command: TCommand);
begin
  if Command is TBeginEnd then ExecuteBeginEnd(Block, TBeginEnd(Command))
  else if Command is TFunctionCall then ExecuteFunctionCall(Block, TFunctionCall(Command))
  else if Command is TProcedureCall then ExecuteProcedureCall(Block, TProcedureCall(Command))
  else if Command is TAssignment then ExecuteAssignment(Block, TAssignment(Command))
  else if Command is TIfThenElse then ExecuteIfThenElse(Block, TIfThenElse(Command))
  else if Command is TWhileDo then ExecuteWhileDo(Block, TWhileDo(Command))
  else if Command is TRepeatUntil then ExecuteRepeatUntil(Block, TRepeatUntil(Command))
  else if Command is TForToDo then ExecuteForToDo(Block, TForToDo(Command))
  else if Command is TBreak then ExecuteBreak(Block, TBreak(Command))
  else if Command is TContinue then ExecuteContinue(Block, TContinue(Command))
  else if Command is TEmptyCommand then
  else raise Exception.Create(SUnsupportedCommandType);
end;

procedure TExecutor.ExecuteIfThenElse(Block: TExecutorBlock;
  IfThenElse: TIfThenElse);
var
  Value: TValue;
begin
  Value := ExecuteExpression(Block, IfThenElse.Expression);
  if Value is TValueBoolean then begin
    if TValueBoolean(Value).Value then ExecuteCommand(Block, IfThenElse.CommandThen)
      else begin
        if Assigned(IfThenElse.CommandElse) then
          ExecuteCommand(Block, IfThenElse.CommandElse);
      end;
  end else raise Exception.Create(SExpectedBooleanValue);
  FreeAndNil(Value);
end;

procedure TExecutor.ExecuteWhileDo(Block: TExecutorBlock; WhileDo: TWhileDo);
var
  Value: TValue;
  BoolValue: Boolean;
begin
  while True do begin
    Value := ExecuteExpression(Block, WhileDo.Expression);
    if Value is TValueBoolean then begin
      BoolValue := TValueBoolean(Value).Value;
      FreeAndNil(Value);
      if not BoolValue then Break;
      ExecuteCommand(Block, WhileDo.Command);
      if WhileDo.DoContinue then begin
        WhileDo.DoContinue := False;
        Continue;
      end;
      if WhileDo.DoBreak then begin
        WhileDo.DoBreak := False;
        Break;
      end;
    end else raise Exception.Create(SExpectedBooleanValue);
  end;
end;

procedure TExecutor.ExecuteRepeatUntil(Block: TExecutorBlock;
  RepeatUntil: TRepeatUntil);
var
  Value: TValue;
  I: Integer;
  BoolValue: Boolean;
begin
  while True do begin
    for I := 0 to RepeatUntil.Commands.Count - 1 do begin
      ExecuteCommand(Block, TCommand(RepeatUntil.Commands[I]));
      if RepeatUntil.DoContinue then begin
        RepeatUntil.DoContinue := False;
        Continue;
      end;
      if RepeatUntil.DoBreak then begin
        RepeatUntil.DoBreak := False;
        Break;
      end;
    end;
    Value := ExecuteExpression(Block, RepeatUntil.Expression);
    if Value is TValueBoolean then begin
      BoolValue := TValueBoolean(Value).Value;
      FreeAndNil(Value);
      if BoolValue then Break;
    end else raise Exception.Create(SExpectedBooleanValue);
  end;
end;

procedure TExecutor.ExecuteForToDo(Block: TExecutorBlock; ForToDo: TForToDo);
var
  Variable: TExecutorVariable;
  Limit: TValue;
begin
  Variable := Block.GetVariable(ForToDo.VariableRef);
  Variable.Value := ExecuteExpression(Block, ForToDo.ExpressionFrom);
  Limit := ExecuteExpression(Block, ForToDo.ExpressionTo);
  while True do begin
    ExecuteCommand(Block, ForToDo.Command);
    if ForToDo.DoContinue then begin
      ForToDo.DoContinue := False;
      Continue;
    end;
    if ForToDo.DoBreak then begin
      ForToDo.DoBreak := False;
      Break;
    end;
    TValueInteger(Variable.Value).Value := TValueInteger(Variable.Value).Value + 1;
    if TValueInteger(Variable.Value).Value > TValueInteger(Limit).Value then Break;
  end;
  Limit.Free;
end;

procedure TExecutor.ExecuteContinue(Block: TExecutorBlock;
  ContinueCmd: TContinue);
var
  Node: TSourceNode;
begin
  Node := ContinueCmd.Parent;
  while Assigned(Node) and not (Node is TLoop) and Assigned(Node.Parent) do
    Node := Node.Parent;

  if Node is TLoop then TLoop(Node).DoContinue := True
  else raise Exception.Create('Break used outside of loop.');
end;

procedure TExecutor.ExecuteBreak(Block: TExecutorBlock; BreakCmd: TBreak);
var
  Node: TSourceNode;
begin
  Node := BreakCmd.Parent;
  while Assigned(Node) and not (Node is TLoop) and Assigned(Node.Parent) do
    Node := Node.Parent;

  if Node is TLoop then TLoop(Node).DoBreak := True
  else raise Exception.Create('Break used outside of loop.');
end;

procedure TExecutor.ExecuteBlock(ParentBlock: TExecutorBlock; Block: TBlock; ExistingBlock: TExecutorBlock = nil);
var
  ExecutorBlock: TExecutorBlock;
begin
  if Assigned(ExistingBlock) then begin
    ExecutorBlock := ExistingBlock
  end else begin
    ExecutorBlock := TExecutorBlock.Create;
    InitExecutorBlock(ExecutorBlock, Block);
  end;
  ExecutorBlock.Parent := ParentBlock;
  ExecuteBeginEnd(ExecutorBlock, Block.BeginEnd);
  if not Assigned(ExistingBlock) then ExecutorBlock.Free;
end;

function TExecutor.ExecuteFunctionCall(Block: TExecutorBlock;
  FunctionCall: TFunctionCall): TValue;
var
  ExecutorFunction: TExecutorFunction;
  Params: array of TExecutorVariable;
  I: Integer;
  ExecutorVariable: TExecutorVariable;
  Variable: TVariable;
begin
  Result := nil;
  ExecutorFunction := Block.GetFunction(FunctionCall.FunctionDef);
  if Assigned(ExecutorFunction) then begin
    InitExecutorBlock(ExecutorFunction.Block, FunctionCall.FunctionDef.Block);

    // Setup variables
    for I := 0 to FunctionCall.Params.Count - 1 do begin
      Variable := FunctionCall.FunctionDef.Block.Variables.SearchByName(
        TFunctionParameter(FunctionCall.FunctionDef.Params[I]).Name);
      ExecutorVariable := ExecutorFunction.Block.Variables.SearchByVariable(Variable);
      if FunctionCall.FunctionDef.Params[I].Kind = pkVar then begin
        ExecutorVariable.Kind := vkReference;
        Variable := TExpressionOperand(FunctionCall.Params[I]).VariableRef;
        ExecutorVariable.RefVariable := Block.Variables.SearchByVariable(Variable);
      end else begin
        ExecutorVariable.Kind := vkNormal;
        ExecutorVariable.Value := ExecuteExpression(Block, TExpression(FunctionCall.Params[I]));
      end;
    end;

    if FunctionCall.FunctionDef.InternalName <> '' then begin
      SetLength(Params, FunctionCall.Params.Count);
      for I := 0 to FunctionCall.Params.Count - 1 do begin
        Variable := FunctionCall.FunctionDef.Block.Variables.SearchByName(
          TFunctionParameter(FunctionCall.FunctionDef.Params[I]).Name);
        Params[I] := ExecutorFunction.Block.Variables.SearchByVariable(Variable);
      end;
      Result := ExecutorFunction.Callback(Params);
    end else begin
      ExecuteBlock(Block, FunctionCall.FunctionDef.Block, ExecutorFunction.Block);
      ExecutorVariable := ExecutorFunction.Block.Variables.SearchByVariable(
        TVariable(FunctionCall.FunctionDef.Block.Variables.SearchByName('Result')));
      Result := ExecutorVariable.Value.Clone;
    end;
  end else raise Exception.Create('No executor for ' + FunctionCall.FunctionDef.Name + ' function.');
end;

procedure TExecutor.ExecuteProcedureCall(Block: TExecutorBlock;
  ProcedureCall: TProcedureCall);
var
  ExecutorProcedure: TExecutorProcedure;
  Params: array of TExecutorVariable;
  I: Integer;
  ExecutorVariable: TExecutorVariable;
  Variable: TVariable;
  ProcedureDef: TProcedure;
begin
  ExecutorProcedure := Block.GetProcedure(ProcedureCall.ProcedureDef);
  if Assigned(ExecutorProcedure) then begin
    ProcedureDef := ProcedureCall.ProcedureDef;
    InitExecutorBlock(ExecutorProcedure.Block, ProcedureDef.Block);

    for I := 0 to ProcedureCall.Params.Count - 1 do begin
      Variable := ProcedureCall.ProcedureDef.Block.Variables.SearchByName(
        TFunctionParameter(ProcedureCall.ProcedureDef.Params[I]).Name);
      ExecutorVariable := ExecutorProcedure.Block.Variables.SearchByVariable(Variable);
      if ProcedureCall.ProcedureDef.Params[I].Kind = pkVar then begin
        ExecutorVariable.Kind := vkReference;
        Variable := TExpressionOperand(ProcedureCall.Params[I]).VariableRef;
        ExecutorVariable.RefVariable := Block.GetVariable(Variable);
      end else begin
        ExecutorVariable.Kind := vkNormal;
        ExecutorVariable.Value := ExecuteExpression(Block, TExpression(ProcedureCall.Params[I]));
      end;
    end;

    if ProcedureCall.ProcedureDef.InternalName <> '' then begin
      SetLength(Params, ProcedureCall.Params.Count);
      for I := 0 to ProcedureCall.Params.Count - 1 do begin
        Variable := ProcedureCall.ProcedureDef.Block.Variables.SearchByName(
          TFunctionParameter(ProcedureCall.ProcedureDef.Params[I]).Name);
        ExecutorVariable := ExecutorProcedure.Block.Variables.SearchByVariable(Variable);
        Params[I] := ExecutorVariable;
      end;

      ExecutorProcedure.Callback(Params);
    end else begin
      ExecuteBlock(Block, ProcedureCall.ProcedureDef.Block, ExecutorProcedure.Block);
    end;
  end else raise Exception.Create('No executor for ' + ProcedureCall.ProcedureDef.Name + ' function.');
end;

procedure TExecutor.ExecuteAssignment(Block: TExecutorBlock;
  Assignment: TAssignment);
var
  Value: TValue;
  Variable: TExecutorVariable;
  ExecutorFunction: TExecutorFunction;
  Params: array of TExecutorVariable;
begin
  Value := ExecuteExpression(Block, Assignment.Expression);
  Variable := Block.GetVariable(Assignment.Variable);
  ExecutorFunction := Block.GetTypeFunction(Assignment.Variable.TypeRef, '_Assign');
  if Assignment.Variable.TypeRef = Assignment.Expression.GetType then begin
    SetLength(Params, 1);
    Params[0] := TExecutorVariable.Create;
    Params[0].Value := Value;
    Variable.Value := ExecutorFunction.Callback(Params);
  end else raise Exception('Assignment result type is ' + Variable.Variable.TypeRef.Name +
    ' but value is ' + Assignment.Expression.GetType.Name + '.');
  FreeAndNil(Value);
end;

function TExecutor.ExecuteExpression(Block: TExecutorBlock;
  Expression: TExpression): TValue;
begin
  if Expression is TExpressionOperation then
    Result := ExecuteExpressionOperation(Block, TExpressionOperation(Expression))
  else
  if Expression is TExpressionOperand then
    Result := ExecuteExpressionOperand(Block, TExpressionOperand(Expression))
  else
  if Expression is TExpressionBrackets then
    Result := ExecuteExpressionBrackets(Block, TExpressionBrackets(Expression))
  else
  raise Exception.Create('Unknown expression class.');
end;

function TExecutor.ExecuteExpressionOperation(Block: TExecutorBlock;
  Expression: TExpressionOperation): TValue;
var
  I: Integer;
  Value: TValue;
  ExecutorFunction: TExecutorFunction;
  Params: array of TExecutorVariable;
  FuncName: string;
begin
  FuncName := Expression.GetFunctionName;

  ExecutorFunction := Block.GetTypeFunction(Expression.FunctionRef.ParentType, FuncName);
  if not Assigned(ExecutorFunction) then
    raise Exception.Create('Missing operator function ' + FuncName + ' for type ' + Expression.TypeRef.Name);

  SetLength(Params, Expression.Items.Count);
  for I := 0 to Expression.Items.Count - 1 do begin
    Value := ExecuteExpression(Block, TExpression(Expression.Items[I]));
    Params[I] := TExecutorVariable.Create;
    Params[I].Value := Value;
  end;
  Result := ExecutorFunction.Callback(Params);
  for I := 0 to Expression.Items.Count - 1 do begin
    Params[I].Free;
  end;
end;

function TExecutor.ExecuteExpressionOperand(Block: TExecutorBlock;
  Expression: TExpressionOperand): TValue;
begin
  case Expression.OperandType of
    otFunctionCall: Result := ExecuteFunctionCall(Block, Expression.FunctionCall);
    otConstantDirect: Result := Expression.ConstantDirect.Value.Clone;
    otConstantRef: Result := Expression.ConstantRef.Value.Clone;
    otVariableRef: Result := Block.Variables.SearchByVariable(Expression.VariableRef).Value.Clone;
    else raise Exception.Create(SUnsupportedOperandType);
  end;
end;

function TExecutor.ExecuteExpressionBrackets(Block: TExecutorBlock;
  Expression: TExpressionBrackets): TValue;
begin
  Result := ExecuteExpression(Block, Expression.Expression);
end;

procedure TExecutor.Run;
begin
  ExecuteProgram(Prog);
end;

procedure TExecutor.Output(Text: string);
begin
  if Assigned(FOnOutput) then
    FOnOutput(Text);
end;

function TExecutor.Input: string;
begin
  if Assigned(FOnInput) then
    Result := FOnInput;
end;

end.