Changeset 214

Timestamp:

Apr 23, 2020, 12:24:31 AM (5 years ago)

Author:

chronos

Message:

• Added: Execution of user defined functions.

Location:

branches/interpreter2

Files:

• Test.pas (modified) (1 diff)
• UExecutor.pas (modified) (10 diffs)

branches/interpreter2/Test.pas

@@ -25 +25 @@
     WriteLn('DoThen');
   end else WriteLn('DoElse');
+  
+  if IsZero(1) then begin
+    WriteLn('Is really zero');
+  end;
 
   // While-Do

branches/interpreter2/UExecutor.pas

@@ -10 +10 @@
 type
   TExecutorFunctions = class;
+  TExecutorBlock = class;
 
   { TExecutorVariable }
@@ -45 +46 @@
   TExecutorFunctionCallback = function(Params: array of TValue): TValue of object;
 
+  { TExecutorFunction }
+
   TExecutorFunction = class
     FunctionDef: TFunction;
+    Block: TExecutorBlock;
     Callback: TExecutorFunctionCallback;
+    constructor Create;
+    destructor Destroy; override;
   end;
 
@@ -85 +91 @@
     function ExecuteIntToStr(Params: array of TValue): TValue;
     function ExecuteStrToInt(Params: array of TValue): TValue;
+    function ExecuteBooleanAssign(Params: array of TValue): TValue;
+    function ExecuteBooleanEqual(Params: array of TValue): TValue;
+    function ExecuteBooleanNotEqual(Params: array of TValue): TValue;
     function ExecuteStringAssign(Params: array of TValue): TValue;
     function ExecuteStringAdd(Params: array of TValue): TValue;
@@ -106 +115 @@
     procedure ExecuteContinue(Block: TExecutorBlock; ContinueCmd: TContinue);
     procedure ExecuteBreak(Block: TExecutorBlock; BreakCmd: TBreak);
-    procedure ExecuteBlock(ParentBlock: TExecutorBlock; Block: TBlock);
+    procedure ExecuteBlock(ParentBlock: TExecutorBlock; Block: TBlock; ExistingBlock: TExecutorBlock = nil);
     function ExecuteFunctionCall(Block: TExecutorBlock; FunctionCall: TFunctionCall): TValue;
     procedure ExecuteAssignment(Block: TExecutorBlock; Assignment: TAssignment);
@@ -120 +129 @@
 implementation
 
+{ TExecutorFunction }
+
+constructor TExecutorFunction.Create;
+begin
+  Block := TExecutorBlock.Create;
+end;
+
+destructor TExecutorFunction.Destroy;
+begin
+  Block.Free;
+  inherited Destroy;
+end;
+
 { TExecutorVariable }
 
@@ -295 +317 @@
 end;
 
+function TExecutor.ExecuteBooleanAssign(Params: array of TValue): TValue;
+begin
+  Result := TValueBoolean.Create;
+  TValueBoolean(Result).Value := TValueBoolean(Params[0]).Value;
+end;
+
+function TExecutor.ExecuteBooleanEqual(Params: array of TValue): TValue;
+begin
+  Result := TValueBoolean.Create;
+  TValueBoolean(Result).Value := TValueBoolean(Params[0]).Value = TValueBoolean(Params[1]).Value;
+end;
+
+function TExecutor.ExecuteBooleanNotEqual(Params: array of TValue): TValue;
+begin
+  Result := TValueBoolean.Create;
+  TValueBoolean(Result).Value := TValueBoolean(Params[0]).Value <> TValueBoolean(Params[1]).Value;
+end;
+
 function TExecutor.ExecuteStringAssign(Params: array of TValue): TValue;
 begin
@@ -360 +400 @@
     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;
+      end else
       if ExecutorType.TypeRef.Name = 'string' then begin
         if ExecutorFunction.FunctionDef.Name = '_Assign' then begin
@@ -373 +424 @@
           ExecutorFunction.Callback := ExecuteStringNotEqual;
         end;
-      end;
+      end else
       if ExecutorType.TypeRef.Name = 'Integer' then begin
         if ExecutorFunction.FunctionDef.Name = '_Assign' then begin
@@ -557 +608 @@
 end;
 
-procedure TExecutor.ExecuteBlock(ParentBlock: TExecutorBlock; Block: TBlock);
+procedure TExecutor.ExecuteBlock(ParentBlock: TExecutorBlock; Block: TBlock; ExistingBlock: TExecutorBlock = nil);
 var
   ExecutorBlock: TExecutorBlock;
 begin
-  ExecutorBlock := TExecutorBlock.Create;
+  if Assigned(ExistingBlock) then begin
+    ExecutorBlock := ExistingBlock
+  end else begin
+    ExecutorBlock := TExecutorBlock.Create;
+    InitExecutorBlock(ExecutorBlock, Block);
+  end;
   ExecutorBlock.Parent := ParentBlock;
-  InitExecutorBlock(ExecutorBlock, Block);
   ExecuteBeginEnd(ExecutorBlock, Block.BeginEnd);
-  ExecutorBlock.Free;
+  if not Assigned(ExistingBlock) then ExecutorBlock.Free;
 end;
 
@@ -574 +629 @@
   Params: array of TValue;
   I: Integer;
+  ExecutorVariable: TExecutorVariable;
+  Variable: TVariable;
 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 begin
-      Params[I] := ExecuteExpression(Block, TExpression(FunctionCall.Params[0]));
-    end;
-    Result := ExecutorFunction.Callback(Params);
-    for I := 0 to FunctionCall.Params.Count - 1 do begin
-      Params[I].Free;
+    if FunctionCall.FunctionDef.InternalName <> '' then begin
+      SetLength(Params, FunctionCall.Params.Count);
+      for I := 0 to FunctionCall.Params.Count - 1 do begin
+        Params[I] := ExecuteExpression(Block, TExpression(FunctionCall.Params[0]));
+      end;
+      Result := ExecutorFunction.Callback(Params);
+      for I := 0 to FunctionCall.Params.Count - 1 do begin
+        Params[I].Free;
+      end;
+    end else begin
+      InitExecutorBlock(ExecutorFunction.Block, FunctionCall.FunctionDef.Block);
+      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);
+        ExecutorVariable.Value.Free;
+        ExecutorVariable.Value := ExecuteExpression(Block, TExpression(FunctionCall.Params[I]));
+      end;
+      ExecuteBlock(Block, FunctionCall.FunctionDef.Block, ExecutorFunction.Block);
+      ExecutorVariable := ExecutorFunction.Block.Variables.SearchByVariable(TVariable(FunctionCall.FunctionDef.Block.Variables.SearchByName('Result')));
+      Result := ExecutorVariable.Value;
     end;
   end else raise Exception.Create('No executor for ' + FunctionCall.FunctionDef.Name + ' function.');