Changeset 202 for branches/interpreter2/UExecutor.pas

Timestamp:

Apr 17, 2020, 12:09:15 AM (5 years ago)

Author:

chronos

Message:

• Added: Support for String, Integer and Boolean types.
• Added: Support for more system defined functions..
• Added: Support for line comments.
• Added: For-To-Do construction.
• Added: Defined function parameters and and parsing function calls with parameters.
• Modified: Improved handling of expressions.

File:

• branches/interpreter2/UExecutor.pas (modified) (14 diffs)

branches/interpreter2/UExecutor.pas

@@ -9 +9 @@
 
 type
+  TExecutorFunctions = class;
+
   TExecutorVariable = class
     Variable: TVariable;
-    Value: string;
+    Value: TValue;
   end;
 
@@ -21 +23 @@
   end;
 
-  TExecutorFunctionCallback = function(Params: array of string): string of object;
+  { TExecutorType }
+
+  TExecutorType = class
+    TypeRef: TType;
+    Functions: TExecutorFunctions;
+    constructor Create;
+    destructor Destroy; override;
+  end;
+
+  { TExecutorTypes }
+
+  TExecutorTypes = class(TObjectList)
+    function SearchByType(TypeRef: TType): TExecutorType;
+    function AddNew(TypeRef: TType): TExecutorType;
+  end;
+
+  TExecutorFunctionCallback = function(Params: array of TValue): TValue of object;
 
   TExecutorFunction = class
@@ -39 +57 @@
   TExecutorBlock = class
     Parent: TExecutorBlock;
+    Types: TExecutorTypes;
     Variables: TExecutorVariables;
     Functions: TExecutorFunctions;
     function GetFunction(FunctionDef: TFunction): TExecutorFunction;
+    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;
@@ -54 +77 @@
     FOnOutput: TOutputEvent;
     SystemBlock: TExecutorBlock;
-    function ExecuteWriteLn(Params: array of string): string;
-    function ExecuteWrite(Params: array of string): string;
+    function ExecuteWriteLn(Params: array of TValue): TValue;
+    function ExecuteWrite(Params: array of TValue): TValue;
+    function ExecuteIntToStr(Params: array of TValue): TValue;
+    function ExecuteStrToInt(Params: array of TValue): TValue;
+    function ExecuteStringAssign(Params: array of TValue): TValue;
+    function ExecuteStringAdd(Params: array of TValue): TValue;
+    function ExecuteStringEqual(Params: array of TValue): TValue;
+    function ExecuteStringNotEqual(Params: array of TValue): TValue;
+    function ExecuteIntegerAssign(Params: array of TValue): TValue;
+    function ExecuteIntegerAdd(Params: array of TValue): TValue;
+    function ExecuteIntegerSub(Params: array of TValue): TValue;
+    function ExecuteIntegerEqual(Params: array of TValue): TValue;
+    function ExecuteIntegerNotEqual(Params: array of TValue): TValue;
     procedure InitExecutorBlock(ExecutorBlock: TExecutorBlock; Block: TBlock);
   public
@@ -64 +98 @@
     procedure ExecuteIfThenElse(Block: TExecutorBlock; IfThenElse: TIfThenElse);
     procedure ExecuteWhileDo(Block: TExecutorBlock; WhileDo: TWhileDo);
+    procedure ExecuteForToDo(Block: TExecutorBlock; ForToDo: TForToDo);
     procedure ExecuteBlock(ParentBlock: TExecutorBlock;Block: TBlock);
-    function ExecuteFunctionCall(Block: TExecutorBlock; FunctionCall: TFunctionCall): string;
+    function ExecuteFunctionCall(Block: TExecutorBlock; FunctionCall: TFunctionCall): TValue;
     procedure ExecuteAssignment(Block: TExecutorBlock; Assignment: TAssignment);
-    function ExecuteExpression(Block: TExecutorBlock; Expression: TExpression): string;
+    function ExecuteExpression(Block: TExecutorBlock; Expression: TExpression): TValue;
+    function ExecuteExpressionOperation(Block: TExecutorBlock; Expression: TExpressionOperation): TValue;
+    function ExecuteExpressionOperand(Block: TExecutorBlock; Expression: TExpressionOperand): TValue;
     procedure Run;
     procedure Output(Text: string);
@@ -75 +112 @@
 
 implementation
+
+{ TExecutorType }
+
+constructor TExecutorType.Create;
+begin
+  Functions := TExecutorFunctions.Create;
+end;
+
+destructor TExecutorType.Destroy;
+begin
+  Functions.Free;
+  inherited Destroy;
+end;
+
+{ TExecutorTypes }
+
+function TExecutorTypes.SearchByType(TypeRef: TType): TExecutorType;
+var
+  I: Integer;
+begin
+  I := 0;
+  while (I < Count) and (TExecutorType(Items[I]).TypeRef <> TypeRef) do Inc(I);
+  if I < Count then Result := TExecutorType(Items[I])
+    else Result := nil;
+end;
+
+function TExecutorTypes.AddNew(TypeRef: TType): TExecutorType;
+begin
+  Result := TExecutorType.Create;
+  Result.TypeRef := TypeRef;
+  Add(Result);
+end;
 
 { TExecutorFunctions }
@@ -124 +193 @@
 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;
@@ -134 +233 @@
   Variables.Free;
   Functions.Free;
+  Types.Free;
   inherited Destroy;
 end;
@@ -139 +239 @@
 { TExecutor }
 
-function TExecutor.ExecuteWriteLn(Params: array of string): string;
+function TExecutor.ExecuteWriteLn(Params: array of TValue): TValue;
 var
   I: Integer;
   Text: string;
 begin
-  Result := '';
+  Result := nil;
   Text := '';
   for I := 0 to Length(Params) - 1 do
-    Text := Text + Params[I];
+    Text := Text + TValueString(Params[I]).Value;
   Output(Text + LineEnding);
 end;
 
-function TExecutor.ExecuteWrite(Params: array of string): string;
+function TExecutor.ExecuteWrite(Params: array of TValue): TValue;
 var
   I: Integer;
   Text: string;
 begin
-  Result := '';
+  Result := nil;
   Text := '';
   for I := 0 to Length(Params) - 1 do
-    Text := Text + Params[I];
+    Text := Text + TValueString(Params[I]).Value;
   Output(Text);
 end;
 
+function TExecutor.ExecuteIntToStr(Params: array of TValue): TValue;
+begin
+  Result := TValueString.Create;
+  TValueString(Result).Value := IntToStr(TValueInteger(Params[0]).Value);
+end;
+
+function TExecutor.ExecuteStrToInt(Params: array of TValue): TValue;
+begin
+  Result := TValueInteger.Create;
+  TValueInteger(Result).Value := StrToInt(TValueString(Params[0]).Value);
+end;
+
+function TExecutor.ExecuteStringAssign(Params: array of TValue): TValue;
+begin
+  Result := TValueString.Create;
+  TValueString(Result).Value := TValueString(Params[0]).Value;
+end;
+
+function TExecutor.ExecuteStringAdd(Params: array of TValue): TValue;
+begin
+  Result := TValueString.Create;
+  TValueString(Result).Value := TValueString(Params[0]).Value + TValueString(Params[1]).Value;
+end;
+
+function TExecutor.ExecuteStringEqual(Params: array of TValue): TValue;
+begin
+  Result := TValueBoolean.Create;
+  TValueBoolean(Result).Value := TValueString(Params[0]).Value = TValueString(Params[1]).Value;
+end;
+
+function TExecutor.ExecuteStringNotEqual(Params: array of TValue): TValue;
+begin
+  Result := TValueBoolean.Create;
+  TValueBoolean(Result).Value := TValueString(Params[0]).Value <> TValueString(Params[1]).Value;
+end;
+
+function TExecutor.ExecuteIntegerAssign(Params: array of TValue): TValue;
+begin
+  Result := TValueInteger.Create;
+  TValueInteger(Result).Value := TValueInteger(Params[0]).Value;
+end;
+
+function TExecutor.ExecuteIntegerAdd(Params: array of TValue): TValue;
+begin
+  Result := TValueInteger.Create;
+  TValueInteger(Result).Value := TValueInteger(Params[0]).Value + TValueInteger(Params[1]).Value;
+end;
+
+function TExecutor.ExecuteIntegerSub(Params: array of TValue): TValue;
+begin
+  Result := TValueInteger.Create;
+  TValueInteger(Result).Value := TValueInteger(Params[0]).Value - TValueInteger(Params[1]).Value;
+end;
+
+function TExecutor.ExecuteIntegerEqual(Params: array of TValue): TValue;
+begin
+  Result := TValueBoolean.Create;
+  TValueBoolean(Result).Value := TValueInteger(Params[0]).Value = TValueInteger(Params[1]).Value;
+end;
+
+function TExecutor.ExecuteIntegerNotEqual(Params: array of TValue): TValue;
+begin
+  Result := TValueBoolean.Create;
+  TValueBoolean(Result).Value := TValueInteger(Params[0]).Value <> TValueInteger(Params[1]).Value;
+end;
+
 procedure TExecutor.InitExecutorBlock(ExecutorBlock: TExecutorBlock; Block: TBlock);
 var
   I: Integer;
+  J: Integer;
   ExecutorFunction: TExecutorFunction;
-begin
+  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 = '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;
+      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 = '_Equal' then begin
+          ExecutorFunction.Callback := ExecuteIntegerEqual;
+        end else
+        if ExecutorFunction.FunctionDef.Name = '_NotEqual' then begin
+          ExecutorFunction.Callback := ExecuteIntegerNotEqual;
+        end;
+      end;
+    end;
+  end;
   for I := 0 to Block.Variables.Count - 1 do
     ExecutorBlock.Variables.AddNew(TVariable(Block.Variables[I]));
   for I := 0 to Block.Functions.Count - 1 do begin
     ExecutorFunction := ExecutorBlock.Functions.AddNew(TFunction(Block.Functions[I]));
-    if ExecutorFunction.FunctionDef.Name = 'Write' then ExecutorFunction.Callback := ExecuteWrite
-    else if ExecutorFunction.FunctionDef.Name = 'WriteLn' then ExecutorFunction.Callback := ExecuteWriteLn;
+    if ExecutorFunction.FunctionDef.Name = 'Write' then begin
+      ExecutorFunction.Callback := ExecuteWrite;
+    end else
+    if ExecutorFunction.FunctionDef.Name = 'WriteLn' then begin
+      ExecutorFunction.Callback := ExecuteWriteLn;
+    end;
+    if ExecutorFunction.FunctionDef.Name = 'IntToStr' then begin
+      ExecutorFunction.Callback := ExecuteIntToStr;
+    end else
+    if ExecutorFunction.FunctionDef.Name = 'StrToInt' then begin
+      ExecutorFunction.Callback := ExecuteStrToInt;
+    end;
   end;
 end;
@@ -200 +415 @@
   else if Command is TIfThenElse then ExecuteIfThenElse(Block, TIfThenElse(Command))
   else if Command is TWhileDo then ExecuteWhileDo(Block, TWhileDo(Command))
+  else if Command is TForToDo then ExecuteForToDo(Block, TForToDo(Command))
   else raise Exception.Create('Unsupported command type');
 end;
@@ -206 +422 @@
   IfThenElse: TIfThenElse);
 var
-  Value: string;
+  Value: TValue;
 begin
   Value := ExecuteExpression(Block, IfThenElse.Expression);
-  if Value <> '' then ExecuteCommand(Block, IfThenElse.CommandThen)
-    else ExecuteCommand(Block, IfThenElse.CommandElse);
+  if Value is TValueBoolean then begin
+    if TValueBoolean(Value).Value then ExecuteCommand(Block, IfThenElse.CommandThen)
+      else ExecuteCommand(Block, IfThenElse.CommandElse);
+  end else raise Exception.Create('Expected boolean value.');
 end;
 
 procedure TExecutor.ExecuteWhileDo(Block: TExecutorBlock; WhileDo: TWhileDo);
 var
-  Value: string;
+  Value: TValue;
 begin
   while True do begin
     Value := ExecuteExpression(Block, WhileDo.Expression);
-    if Value <> '' then Continue
-      else Break;
+    if Value is TValueBoolean then begin
+      if not TValueBoolean(Value).Value then Break;
+      ExecuteCommand(Block, WhileDo.Command);
+    end else raise Exception.Create('Expected boolean value.');
+  end;
+end;
+
+procedure TExecutor.ExecuteForToDo(Block: TExecutorBlock; ForToDo: TForToDo);
+var
+  Value: TValue;
+  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);
+    TValueInteger(Variable.Value).Value := TValueInteger(Variable.Value).Value + 1;
+    if TValueInteger(Variable.Value).Value > TValueInteger(Limit).Value then Break;
   end;
 end;
@@ -236 +472 @@
 
 function TExecutor.ExecuteFunctionCall(Block: TExecutorBlock;
-  FunctionCall: TFunctionCall): string;
+  FunctionCall: TFunctionCall): TValue;
 var
   ExecutorFunction: TExecutorFunction;
-  Params: array of string;
-  I: Integer;
-begin
-  Result := '';
+  Params: array of TValue;
+  I: Integer;
+begin
+  Result := nil;
   ExecutorFunction := Block.GetFunction(FunctionCall.FunctionDef);
   if Assigned(ExecutorFunction) then begin
     SetLength(Params, FunctionCall.Params.Count);
-    for I := 0 to FunctionCall.Params.Count - 1 do
+    for I := 0 to FunctionCall.Params.Count - 1 do begin
       Params[I] := ExecuteExpression(Block, TExpression(FunctionCall.Params[0]));
+    end;
     Result := ExecutorFunction.Callback(Params);
   end else raise Exception.Create('No executor for ' + FunctionCall.FunctionDef.Name + ' function.');
@@ -255 +492 @@
   Assignment: TAssignment);
 var
-  Value: string;
+  Value: TValue;
   Variable: TExecutorVariable;
+  ExecutorFunction: TExecutorFunction;
+  Params: array of TValue;
 begin
   Value := ExecuteExpression(Block, Assignment.Expression);
-  Variable := Block.Variables.SearchByVariable(Assignment.Variable);
-  Variable.Value := Value;
+  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] := 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 + '.');
 end;
 
 function TExecutor.ExecuteExpression(Block: TExecutorBlock;
-  Expression: TExpression): string;
+  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 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 TValue;
+  FuncName: string;
+begin
+  if Expression.Operation = eoAdd then FuncName := '_Add'
+  else if Expression.Operation = eoSub then FuncName := '_Sub'
+  else if Expression.Operation = eoEqual then FuncName := '_Equal'
+  else if Expression.Operation = eoNotEqual then FuncName := '_NotEqual'
+  else raise Exception.Create('Unsupported operation type.');
+
+  ExecutorFunction := Block.GetTypeFunction(Expression.TypeRef, FuncName);
+  Result := Expression.TypeRef.ValueClass.Create;
+
+  SetLength(Params, Expression.Items.Count);
+  for I := 0 to Expression.Items.Count - 1 do begin
+    Value := ExecuteExpression(Block, TExpression(Expression.Items[I]));
+    Params[I] := Value;
+  end;
+  Result := ExecutorFunction.Callback(Params);
+end;
+
+function TExecutor.ExecuteExpressionOperand(Block: TExecutorBlock;
+  Expression: TExpressionOperand): TValue;
 begin
   if Assigned(Expression.VariableRef) then begin
@@ -274 +556 @@
   if Assigned(Expression.FunctionCall) then begin
     Result := ExecuteFunctionCall(Block, Expression.FunctionCall);
-  end;
+  end else raise Exception.Create('Unsupported exception operand type.');
 end;