Changeset 233 for branches/xpascal/Executor.pas

Timestamp:

Jun 26, 2023, 6:08:23 PM (11 months ago)

Author:

chronos

Message:

• Added: Support for procedures.
• Added: Project pascal file can be opened from main menu. Last file name is remembered.
• Modified: Improved XML output of source structure.

File:

• branches/xpascal/Executor.pas (modified) (10 diffs)

branches/xpascal/Executor.pas

@@ -71 +71 @@
   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 }
 
@@ -78 +95 @@
     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;
@@ -144 +163 @@
     procedure ExecuteBlock(ParentBlock: TExecutorBlock; Block: TBlock; ExistingBlock: TExecutorBlock = nil);
     function ExecuteFunctionCall(Block: TExecutorBlock; FunctionCall: TFunctionCall): TValue;
+    function ExecuteProcedureCall(Block: TExecutorBlock; ProcedureCall: TProcedureCall): TValue;
     procedure ExecuteAssignment(Block: TExecutorBlock; Assignment: TAssignment);
     function ExecuteExpression(Block: TExecutorBlock; Expression: TExpression): TValue;
@@ -167 +187 @@
   SExpectedBooleanValue = 'Expected boolean value.';
 
+{ TExecutorProcedures }
+
+function TExecutorProcedures.SearchByProcedure(ProcedureDef: TProcedure
+  ): TExecutorProcedure;
+var
+  I: Integer;
+begin
+  I := 0;
+  while (I < Count) and (TExecutorProcedure(Items[I]).ProcedureDef <> ProcedureDef) do Inc(I);
+  if I < Count then Result := TExecutorProcedure(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;
+
 { TExecutorFunctionCallbackParam }
 
@@ -281 +335 @@
 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
@@ -315 +377 @@
   Variables := TExecutorVariables.Create;
   Functions := TExecutorFunctions.Create;
+  Procedures := TExecutorProcedures.Create;
 end;
 
@@ -321 +384 @@
   FreeAndNil(Variables);
   FreeAndNil(Functions);
+  FreeAndNil(Procedures);
   FreeAndNil(Types);
   inherited;
@@ -703 +767 @@
 begin
   for I := 0 to BeginEnd.Commands.Count - 1 do
-    ExecuteCommand(Block, TCommand(BeginEnd.Commands[I]));
+    ExecuteCommand(Block, BeginEnd.Commands[I]);
 end;
 
@@ -710 +774 @@
   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))
@@ -899 +964 @@
 end;
 
+function TExecutor.ExecuteProcedureCall(Block: TExecutorBlock;
+  ProcedureCall: TProcedureCall): TValue;
+var
+  ExecutorProcedure: TExecutorProcedure;
+  Params: array of TExecutorFunctionCallbackParam;
+  I: Integer;
+  ExecutorVariable: TExecutorVariable;
+  Variable: TVariable;
+begin
+  Result := nil;
+  ExecutorProcedure := Block.GetProcedure(ProcedureCall.ProcedureDef);
+  if Assigned(ExecutorProcedure) then begin
+    if ProcedureCall.ProcedureDef.InternalName <> '' then begin
+      SetLength(Params, ProcedureCall.Params.Count);
+      for I := 0 to ProcedureCall.Params.Count - 1 do begin
+        Params[I] := TExecutorFunctionCallbackParam.Create;
+        Params[I].Kind := ProcedureCall.ProcedureDef.Params[I].Kind;
+        if ProcedureCall.ProcedureDef.Params[I].Kind = pkVar then begin
+          Variable := TExpressionOperand(ProcedureCall.Params[I]).VariableRef;
+          //InitExecutorBlock(ExecutorFunction.Block, FunctionCall.FunctionDef.Block);
+          ExecutorVariable := Block.GetVariable(Variable);
+          Params[I].Variable := ExecutorVariable;
+        end
+        else Params[I].Value := ExecuteExpression(Block, ProcedureCall.Params[I]);
+      end;
+      Result := ExecutorProcedure.Callback(Params);
+      for I := 0 to ProcedureCall.Params.Count - 1 do begin
+        //if FunctionCall.Params[I].
+        Params[I].Free;
+      end;
+    end else begin
+      InitExecutorBlock(ExecutorProcedure.Block, ProcedureCall.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);
+        ExecutorVariable.Value.Free;
+        ExecutorVariable.Value := ExecuteExpression(Block, TExpression(ProcedureCall.Params[I]));
+      end;
+      ExecuteBlock(Block, ProcedureCall.ProcedureDef.Block, ExecutorProcedure.Block);
+      ExecutorVariable := ExecutorProcedure.Block.Variables.SearchByVariable(
+        TVariable(ProcedureCall.ProcedureDef.Block.Variables.SearchByName('Result')));
+      Result := ExecutorVariable.Value.Clone;
+    end;
+  end else raise Exception.Create('No executor for ' + ProcedureCall.ProcedureDef.Name + ' function.');
+end;
+
 procedure TExecutor.ExecuteAssignment(Block: TExecutorBlock;
   Assignment: TAssignment);