Changeset 101 for branches/interpreter/Execute3.pas

Timestamp:

Feb 11, 2017, 4:35:08 PM (8 years ago)

Author:

chronos

Message:

• Modified: Improved interpeter. Better handling of execution of functions and passing value of parameters.

File:

• branches/interpreter/Execute3.pas (modified) (10 diffs)

branches/interpreter/Execute3.pas

@@ -8 +8 @@
 type
   TVariableValue = record
+    VarRef: PVariable;
     BaseType: TBaseType;
     case Integer of
-      0: (ValueChar: Char);
-      1: (ValueInteger: Integer);
-      2: (ValueString: ShortString);
-      3: (ValueBoolean: Boolean);
+      btChar: (ValueChar: Char);
+      btInteger: (ValueInteger: Integer);
+      btShortString: (ValueString: ShortString);
+      btBoolean: (ValueBoolean: Boolean);
   end;
   PVariableValue = ^TVariableValue;
+
+  { TVariableValues }
 
   TVariableValues = record
     Items: array of TVariableValue;
+    function GetByName(Name: string): PVariableValue;
   end;
 
@@ -40 +44 @@
 var
   ExecutionContexts: TExecutionContexts;
+  ExecutionContextCurrent: PExecutionContext;
+  MainCode: PProgramCode;
 
 procedure ExecuteProgram(ProgramCode: PProgramCode);
@@ -47 +53 @@
 
 procedure ExecuteCommand(Command: PCommand); forward;
+procedure ExecuteGetValue(GetValue: PGetValue; Value: PVariableValue); forward;
+procedure AssignVariable(Dest, Source: PVariableValue); forward;
+procedure ExecuteExecution(Execution: PExecution; ReturnValue: PVariableValue); forward;
+
+
+procedure ShowError(Text: string);
+begin
+  WriteLn(Text);
+  Halt;
+end;
 
 procedure ExecuteBeginEnd(BeginEnd: PBeginEnd);
@@ -56 +72 @@
 end;
 
-function ExecuteExpressionBoolean(Expression: PExpression): Boolean;
-begin
-
+procedure ShowErrorType(Variable: PVariableValue);
+begin
+  ShowError('Not suppoted type')
+end;
+
+procedure VariableAdd(Result, Operand: PVariableValue);
+begin
+  case Result^.BaseType of
+    btBoolean: ShowErrorType(Result);
+    btChar: ShowErrorType(Result);
+    btInteger: Result^.ValueInteger := Result^.ValueInteger + Operand^.ValueInteger;
+    btShortString: Result^.ValueString := Result^.ValueString + Operand^.ValueString;
+  end;
+end;
+
+procedure VariableSubtract(Result, Operand: PVariableValue);
+begin
+  case Result^.BaseType of
+    btBoolean: ShowErrorType(Result);
+    btChar: ShowErrorType(Result);
+    btInteger: Result^.ValueInteger := Result^.ValueInteger - Operand^.ValueInteger;
+    btShortString: ShowErrorType(Result);
+  end;
+end;
+
+procedure VariableAnd(Result, Operand: PVariableValue);
+begin
+  case Result^.BaseType of
+    btBoolean: Result^.ValueBoolean := Result^.ValueBoolean and Operand^.ValueBoolean;
+    btChar: ShowErrorType(Result);
+    btInteger: Result^.ValueInteger := Result^.ValueInteger and Operand^.ValueInteger;
+    btShortString: ShowErrorType(Result);
+  end;
+end;
+
+procedure VariableOr(Result, Operand: PVariableValue);
+begin
+  case Result^.BaseType of
+    btBoolean: Result^.ValueBoolean := Result^.ValueBoolean or Operand^.ValueBoolean;
+    btChar: ShowErrorType(Result);
+    btInteger: Result^.ValueInteger := Result^.ValueInteger or Operand^.ValueInteger;
+    btShortString: ShowErrorType(Result);
+  end;
+end;
+
+procedure VariableEqual(Result, Operand1, Operand2: PVariableValue);
+begin
+  case Result^.BaseType of
+    btBoolean: Result^.ValueBoolean := Operand1^.ValueBoolean = Operand2^.ValueBoolean;
+    btChar: ShowErrorType(Result);
+    btInteger: ShowErrorType(Result);
+    btShortString: ShowErrorType(Result);
+  end;
+end;
+
+procedure VariableNotEqual(Result, Operand1, Operand2: PVariableValue);
+begin
+  case Result^.BaseType of
+    btBoolean: Result^.ValueBoolean := Operand1^.ValueBoolean <> Operand2^.ValueBoolean;
+    btChar: ShowErrorType(Result);
+    btInteger: ShowErrorType(Result);
+    btShortString: ShowErrorType(Result);
+  end;
+end;
+
+procedure ExecuteExpression(Expression: PExpression; Value: PVariableValue);
+var
+  I: Integer;
+  SubValue: TVariableValue;
+begin
+  if Expression^.NodeType = ntOperator then begin
+    I := 0;
+    while I < Length(Expression^.Items) do begin
+      if Expression^.Items[I].NodeType = ntOperator then begin
+        ExecuteExpression(@Expression^.Items[I], @SubValue);
+      end else
+      if Expression^.Items[I].NodeType = ntValue then begin
+        ExecuteGetValue(@Expression^.Items[I].Value, @SubValue);
+      end;
+
+      if I = 0 then begin
+        // Just assign first operand
+        case Expression^.OperatorType of
+          opAdd: AssignVariable(Value, @SubValue);
+          opSubtract: AssignVariable(Value, @SubValue);
+          opAnd: AssignVariable(Value, @SubValue);
+          opOr: AssignVariable(Value, @SubValue);
+          opEqual: AssignVariable(Value, @SubValue);
+          opNotEqual: AssignVariable(Value, @SubValue);
+          else ShowError('Unsupported operator type');
+        end;
+      end else begin
+        case Expression^.OperatorType of
+          opAdd: VariableAdd(Value, @SubValue);
+          opSubtract: VariableSubtract(Value, @SubValue);
+          opAnd: VariableAnd(Value, @SubValue);
+          opOr: VariableOr(Value, @SubValue);
+          opEqual: VariableEqual(Value, Value, @SubValue);
+          opNotEqual: VariableNotEqual(Value, Value, @SubValue);
+          else ShowError('Unsupported operator type');
+        end;
+      end;
+      I := I + 1;
+    end;
+  end else
+  if Expression^.NodeType = ntValue then begin
+    ExecuteGetValue(@Expression^.Value, Value);
+  end else ShowError('Uninitialized expression');
+end;
+
+function ExecuteGetValueBoolean(GetValue: PGetValue): Boolean;
+var
+  Value: TVariableValue;
+begin
+  ExecuteGetValue(GetValue, @Value);
+  Result := (Value.BaseType = btBoolean) and Value.ValueBoolean;
 end;
 
 procedure ExecuteWhileDo(WhileDo: PWhileDo);
 begin
-  while ExecuteExpressionBoolean(@WhileDo^.Condition) do
+  while ExecuteGetValueBoolean(@WhileDo^.Condition) do
     ExecuteCommand(@WhileDo^.Command);
 end;
 
 procedure ExecuteIfThenElse(IfThenElse: PIfThenElse);
-begin
-  if ExecuteExpressionBoolean(@IfThenElse^.Condition) then
-    ExecuteCommand(@IfThenElse^.DoThen)
-    else ExecuteCommand(@IfThenElse^.DoElse);
-end;
-
-procedure ExecuteExecution(Execution: PExecution);
-var
-  I: Integer;
-begin
+var
+  Condition: Boolean;
+begin
+  Condition := ExecuteGetValueBoolean(@IfThenElse^.Condition);
+  if Condition then
+    ExecuteCommand(@IfThenElse^.DoThen);
+  if (IfThenElse^.DoElse.CmdType <> ctNone) and not Condition then
+    ExecuteCommand(@IfThenElse^.DoElse);
+end;
+
+procedure AssignConstant(Variable: PVariableValue; Constant: PConstant);
+begin
+  Variable^.BaseType := Constant^.DataType^.BaseType;
+  case Constant^.DataType^.BaseType of
+    btBoolean: Variable^.ValueBoolean := Constant^.ValueBoolean;
+    btInteger: Variable^.ValueInteger := Constant^.ValueInteger;
+    btShortString: Variable^.ValueString := Constant^.ValueString;
+    btChar: Variable^.ValueChar := Constant^.ValueChar;
+  end;
+end;
+
+procedure ExecuteGetValue(GetValue: PGetValue; Value: PVariableValue);
+begin
+  case GetValue.ReadType of
+    rtVariable: AssignVariable(Value, ExecutionContextCurrent^.VariableValues.GetByName(GetValue.Variable^.Name));
+    //rtConstant: Value := ExecutionContextCurrent^.VariableValues.GetByName(GetValue.Variable^.Name);
+    rtExpression: ExecuteExpression(GetValue.Expression, Value);
+    rtValue: AssignConstant(Value, @GetValue.Value);
+    rtFunctionCall: ExecuteExecution(GetValue.FunctionCall, Value)
+  end;
+end;
+
+procedure AssignVariable(Dest, Source: PVariableValue);
+begin
+  Dest.BaseType := Source.BaseType;
+  case Dest.BaseType of
+    btInteger: Dest.ValueInteger := Source.ValueInteger;
+    btChar: Dest.ValueChar := Source.ValueChar;
+    btBoolean: Dest.ValueBoolean := Source.ValueBoolean;
+    btShortString: Dest.ValueString := Source.ValueString;
+  end;
+end;
+
+function IsBuildInFunction(Name: string): Boolean;
+begin
+  Result := (Name = 'WriteLn') or (Name = 'Eof') or (Name = 'Halt') or (Name = 'Read') or
+    (Name = 'Length') or (Name = 'SetLength');
+end;
+
+procedure ExecuteBuildInSetResult(Execution: PExecution; TypeName: string);
+var
+  DataType: PType;
+begin
+  if Execution^.Func^.Variables.GetByName('Result') = nil then begin
+    DataType := MainCode.Types.GetByName(TypeName);
+    Execution^.Func^.Variables.Add(VariableCreate('Result', DataType));
+    SetLength(ExecutionContextCurrent^.VariableValues.Items, Length(ExecutionContextCurrent^.VariableValues.Items) + 1);
+    ExecutionContextCurrent^.VariableValues.Items[0].VarRef := @Execution^.Func^.Variables.Items[Length(Execution^.Func^.Variables.Items) - 1];
+    ExecutionContextCurrent^.VariableValues.Items[0].BaseType := btBoolean;
+  end;
+end;
+
+procedure ExecuteBuildIn(Execution: PExecution);
+begin
+  if Execution^.Func^.Name = 'WriteLn' then begin
+    WriteLn(ExecutionContextCurrent^.VariableValues.GetByName('Text')^.ValueString)
+  end else
+  if Execution^.Func^.Name = 'Halt' then begin
+    Halt;
+  end else
+  if Execution^.Func^.Name = 'Eof' then begin
+    ExecuteBuildInSetResult(Execution, 'Boolean');
+    ExecutionContextCurrent^.VariableValues.GetByName('Result')^.ValueBoolean := True;
+  end else ShowError('Unsupported build-in function.');
+end;
+
+procedure ExecuteExecution(Execution: PExecution; ReturnValue: PVariableValue);
+var
+  I: Integer;
+  Param: PGetValue;
+  ParamValue: TVariableValue;
+  DestVar: PVariableValue;
+  NewContext: TExecutionContext;
+begin
+  // Prepare new execution context
+  FillChar(NewContext, SizeOf(TExecutionContext), 0);
+  NewContext.LoadFromVariables(@Execution^.Func^.Variables);
+
+  // Copy execution parameters to new execution context as local variables
+  for I := 0 to Length(Execution^.Func^.Parameters.Items) - 1 do begin
+    DestVar := NewContext.VariableValues.GetByName(
+      Execution^.Func^.Parameters.Items[I].Name);
+    Param := @Execution^.Parameters.Items[I];
+    ExecuteGetValue(Param, @ParamValue);
+    AssignVariable(DestVar, @ParamValue);
+  end;
+
   ExecutionContexts.Add;
-  ExecutionContexts.Last^.LoadFromVariables(@Execution^.Func^.Variables);
-{  Execution^.Func^.Variables.Add(VariableCreate('Result', Execution^.Func^.ReturnType));
-  for I := 0 to Length(Execution^.Func^.Parameters.Items) - 1 do begin
-    Execution^.Func^.Variables.Add(VariableCreate(Execution^.Func^.Parameters.Items[I].Name,
-      Execution^.Func^.Parameters.Items[I].DataType));
-    case Assignment^.Destination^.DataType^.BaseType of
-      Execution^.Func^.Variables.Items[Length(Execution^.Func^.Variables.Items) - 1].V
-    end;
-  end;
-}
-  ExecuteBeginEnd(@Execution^.Func^.BeginEnd);
+  ExecutionContexts.Items[Length(ExecutionContexts.Items) - 1] := NewContext;
+
+  //WriteLn('Executed ' + Execution^.Func^.Name);
+  if IsBuildInFunction(Execution^.Func^.Name) then ExecuteBuildIn(Execution)
+    else ExecuteBeginEnd(@Execution^.Func^.BeginEnd);
+  if (ReturnValue <> nil) and (Execution^.Func^.ReturnType <> nil) then
+    AssignVariable(ReturnValue, ExecutionContextCurrent^.VariableValues.GetByName('Result'));
   ExecutionContexts.RemoveLast;
 end;
@@ -96 +308 @@
 var
   DestVariable: PVariableValue;
-begin
-  DestVariable := @ExecutionContexts.Last^.VariableValues.Items[Assignment^.Destination^.Index];
-  case DestVariable^.BaseType of
-    btBoolean: DestVariable^.ValueBoolean := ExecuteExpressionBoolean(@Assignment^.Source);
-    //btChar: Assignment^.Destination.ValueBoolean := ExecuteExpressionChar(@Assignment^.Source);
-    //btString: Assignment^.Destination.ValueBoolean := ExecuteExpressionString(@Assignment^.Source);
-    //btInteger: Assignment^.Destination.ValueBoolean := ExecuteExpressionInteger(@Assignment^.Source);
-  end;
+  SrcVariable: TVariableValue;
+begin
+  DestVariable := ExecutionContextCurrent^.VariableValues.GetByName(Assignment^.Destination^.Name);
+  FillChar(SrcVariable, SizeOf(TVariableValue), 0);
+  ExecuteGetValue(@Assignment^.Source, @SrcVariable);
+  AssignVariable(DestVariable, @SrcVariable);
 end;
 
@@ -112 +322 @@
     ctWhileDo: ExecuteWhileDo(Command^.WhileDo);
     ctIfThenElse: ExecuteIfThenElse(Command^.IfThenElse);
-    ctExecution: ExecuteExecution(Command^.Execution);
+    ctExecution: ExecuteExecution(Command^.Execution, nil);
     ctAssignment: ExecuteAssignment(Command^.Assignment);
   end;
@@ -119 +329 @@
 procedure ExecuteProgram(ProgramCode: PProgramCode);
 begin
-  SetLength(ExecutionContexts.Items, 1);
-  ExecutionContexts.Last^.LoadFromVariables(@ProgramCode^.Variables);
+  MainCode := ProgramCode;
+  ExecutionContexts.Add;
+  ExecutionContextCurrent^.LoadFromVariables(@ProgramCode^.Variables);
   ExecuteBeginEnd(@ProgramCode^.BeginEnd);
+end;
+
+{ TVariableValues }
+
+function TVariableValues.GetByName(Name: string): PVariableValue;
+var
+  I: Integer;
+begin
+  I := 0;
+  while (I < Length(Items)) and (Items[I].VarRef^.Name <> Name) do Inc(I);
+  if I < Length(Items) then Result := @Items[I]
+    else Result := nil;
 end;
 
@@ -133 +356 @@
   for I := 0 to Length(Variables.Items) - 1 do begin
     VariableValues.Items[I].BaseType := Variables.Items[I].DataType.BaseType;
+    VariableValues.Items[I].VarRef := @Variables.Items[I];
   end;
 end;
@@ -146 +370 @@
 begin
   SetLength(Items, Length(Items) + 1);
+  ExecutionContextCurrent := Last;
 end;
 
@@ -151 +376 @@
 begin
   SetLength(Items, Length(Items) - 1);
+  ExecutionContextCurrent := Last;
 end;