Changeset 106 for branches/interpreter/interpreter4

Timestamp:

Jul 18, 2017, 12:07:31 AM (7 years ago)

Author:

chronos

Message:

• Modified: Improvements around record type.

Location:

branches/interpreter/interpreter4

Files:

• . (modified) (1 prop)
• Parser.pas (modified) (19 diffs)
• Source.pas (modified) (3 diffs)
• interpreter.lpi (modified) (3 diffs)

branches/interpreter/interpreter4/Parser.pas

@@ -36 +36 @@
 function ParseBeginEnd(BeginEnd: PBeginEnd): Boolean; forward;
 function ParseGetValue(GetValue: PGetValue; NoExpression: Boolean = False): Boolean; forward;
+function ParseAssignment(Assignment: PAssignment): Boolean; forward;
 function ParseUses(UsesSection: PUses): Boolean; forward;
 function ParseType(TypeItem: PType; AllowForward: Boolean): Boolean; forward;
 function ParseTypeFunction(TypeItem: PType; WithName: Boolean = True): Boolean; forward;
 function ParseTypeProcedure(TypeItem: PType; WithName: Boolean = True): Boolean; forward;
+function ParseVariable(out Variable: PVariable): Boolean; forward;
+function ParseExpression(Expression: PExpression): Boolean; forward;
 
 
@@ -66 +69 @@
   Result := (C = ';') or (C = '(') or (C = ')') or (C = ':') or (C = '=') or
     (C = '+') or (C = '-') or (C = ';') or (C = '.') or (C = '{') or (C = '}') or
-    (C = ',') or (C = '^') or (C = '/') or (C = '[') or (C = ']');
+    (C = ',') or (C = '^') or (C = '/') or (C = '[') or (C = ']') or (C = '@');
 end;
 
@@ -173 +176 @@
 end;
 
-function ReadNext: string;
+function ReadNextInternal: string;
 var
   C: Char;
@@ -239 +242 @@
         LastTokenType := ttNumber;
       end else
+      if IsDigit(C) then begin
+        Result := Result + C;
+        LastTokenType := ttNumber;
+      end else
       if C = '''' then begin
         LastTokenType := ttString;
@@ -248 +255 @@
 end;
 
+function ReadNext: string;
+begin
+  Result := ReadNextInternal;
+  WriteLn('ReadNext: ' + Result);
+end;
+
 function CheckNext(Text: string): Boolean;
 var
@@ -254 +267 @@
 begin
   OldPos := InputTextPos;
-  Next := ReadNext;
+  Next := ReadNextInternal;
   Result := Next = Text;
   InputTextPos := OldPos;
+  WriteLn('Check: ' + Next);
 end;
 
@@ -263 +277 @@
   Next: string;
 begin
-  Next := ReadNext;
+  Next := ReadNextInternal;
+  WriteLn('Expect: ' + Next);
   if Next <> Text then
     ShowError('Expected ' + Text + ' but found ' + Next);
@@ -284 +299 @@
   OldPos: Integer;
   Next: string;
+  SelfVariable: PVariable;
+  IndexValue: TGetValue;
 begin
   OldPos := InputTextPos;
@@ -298 +315 @@
         else begin
           Variable := FunctionContext^.Variables.GetByName(Next);
+          if (Variable = nil) then begin
+            SelfVariable := FunctionContext^.Variables.GetByName('Self');
+            if (SelfVariable <> nil) and (SelfVariable^.Value.ValueRecord <> nil) then begin
+              Variable := SelfVariable^.Value.ValueRecord^.GetByName(Next);
+            end;
+          end;
         end;
     end;
     if Variable <> nil then begin
       Result := True;
+      if CheckNext('[') then begin
+        if Variable^.DataType^.BaseType = btArray then begin
+          Expect('[');
+          if ParseGetValue(@IndexValue) then begin
+            //Variable := Variable^.
+          end else ShowError('Expected index value but found ' + ReadNext);
+          Expect(']');
+        end else ShowError('Unexpected array index');
+      end;
+      if CheckNext('.') then begin
+        Expect('.');
+        Continue;
+      end else Break;
     end else begin
       Result := False;
       InputTextPos := OldPos;
     end;
-    if CheckNext('.') then begin
-      Expect('.');
-      Continue;
-    end else Break;
   until False;
+end;
+
+function ParseVariablePointer(out Variable: PVariable): Boolean;
+begin
+  Result := False;
+  if CheckNext('@') then begin
+    Expect('@');
+    Result := True;
+    ParseVariable(Variable);
+  end;
 end;
 
@@ -402 +444 @@
   FoundOperator: Boolean;
   OldPos: Integer;
+  //E: TExpression;
 begin
   OldPos := InputTextPos;
@@ -430 +473 @@
       Break;
     end;
+    //WriteLn('Items count: ' + IntToStr(Length(Expression^.Items)));
   until False;
   if not FoundOperator then begin
@@ -442 +486 @@
       I := 0;
       while (I < Length(Expression^.Items) - 1) do begin
+        //E := TExpression(Expression^.Items[I]);
         if (TExpression(Expression^.Items[I]).NodeType = ntOperator) and
           not TExpression(Expression^.Items[I]).Associated and
           (TExpression(Expression^.Items[I]).OperatorType = OperatorPrecedence[II]) then
         begin
+          //WriteLn('Expression operator ' + OperatorString[OperatorPrecedence[II]]);
           if Expression^.Items[I].OperatorType = opNot then begin
             Expression^.Items[I].Associated := True;
@@ -474 +520 @@
         I := I - 1;
       end;
-    end else ShowError('Expression error ' + IntToStr(Length(Expression^.Items)));
+    end else ShowError('Expression error. Items count: ' + IntToStr(Length(Expression^.Items)));
   end;
 end;
@@ -520 +566 @@
   end else
   if ParseValue(@Value) then begin
+    GetValue^.ReadType := rtValue;
+    GetValue^.Value := Value;
+  end else
+  if ParseVariablePointer(Variable) then begin
     GetValue^.ReadType := rtValue;
     GetValue^.Value := Value;
@@ -748 +798 @@
           // Create subvariables for structured record type variable
           if VarType^.BaseType = btRecord then begin
-            SetLength(Variables^.GetLast^.RecordVariables.Items, 0);
+            SetLength(Variables^.GetLast^.Value.ValueRecord.Items, 0);
             I := 0;
             while (I < Length(VarType^.Fields^.Items)) do begin
-              Variables^.GetLast^.RecordVariables^.Add(
+              Variables^.GetLast^.Value.ValueRecord^.Add(
                 VariableCreate(VarType^.Fields^.Items[I].Name, @VarType^.Fields^.Items[I]));
               I := I + 1;
@@ -825 +875 @@
   ReturnType: string;
   DataType: PType;
+  I: Integer;
 begin
   if CheckNext('function') then begin
@@ -835 +886 @@
         Expect('.');
         Func^.ParentRecord := Func^.Types.GetByName(Func^.Name);
+        Func^.Variables.Add(VariableCreate('Self', Func^.ParentRecord));
+        Func^.Variables.GetLast^.Value.ValueRecord := GetMem(SizeOf(TVariables));
+        FillChar(Func^.Variables.GetLast^.Value.ValueRecord^, SizeOf(TVariables), 0);
+        I := 0;
+        while I < Length(Func^.ParentRecord.Fields.Items) do begin
+          Func^.Variables.GetLast^.Value.ValueRecord^.Add(
+            VariableCreate(Func^.ParentRecord.Fields.Items[I].Name,
+            @(Func^.ParentRecord.Fields.Items[I])));
+          I := I + 1;
+        end;
         Continue;
       end else Break;
@@ -856 +917 @@
 
 function ParseProcedure(Func: PFunction): Boolean;
+var
+  I: Integer;
 begin
   if CheckNext('procedure') then begin
@@ -865 +928 @@
       if CheckNext('.') then begin
         Expect('.');
+        Func^.ParentRecord := Func^.Types.GetByName(Func^.Name);
+        Func^.Variables.Add(VariableCreate('Self', Func^.ParentRecord));
+        Func^.Variables.GetLast^.Value.ValueRecord := GetMem(SizeOf(TVariables));
+        FillChar(Func^.Variables.GetLast^.Value.ValueRecord^, SizeOf(TVariables), 0);
+        I := 0;
+        while I < Length(Func^.ParentRecord.Fields.Items) do begin
+          Func^.Variables.GetLast^.Value.ValueRecord^.Add(
+            VariableCreate(Func^.ParentRecord.Fields.Items[I].Name,
+            @(Func^.ParentRecord.Fields.Items[I])));
+          I := I + 1;
+        end;
         Continue;
       end else Break;

branches/interpreter/interpreter4/Source.pas

@@ -55 +55 @@
   end;
 
-  TVariable = record
-    Name: string;
-    DataType: PType;
-    Index: Integer;
-    RecordVariables: PVariables;
-  end;
-
-  { TVariables }
-
-  TVariables = record
-    ParentList: PVariables;
-    Items: array of TVariable;
-    procedure Add(Variable: TVariable);
-    function GetByName(Name: string): PVariable;
-    function GetLast: PVariable;
-  end;
-
   TConstant = record
     Name: shortstring;
@@ -81 +64 @@
       btShortString: (ValueString: ShortString);
       btBoolean: (ValueBoolean: Boolean);
+      btRecord: (ValueRecord: PVariables);
+      btArray: (ValueArray: PVariables);
   end;
 
@@ -91 +76 @@
   end;
   PConstants = ^TConstants;
+
+  TVariable = record
+    Name: string;
+    DataType: PType;
+    Index: Integer;
+    Value: TConstant;
+  end;
+
+  { TVariables }
+
+  TVariables = record
+    ParentList: PVariables;
+    Items: array of TVariable;
+    procedure Add(Variable: TVariable);
+    function GetByName(Name: string): PVariable;
+    function GetLast: PVariable;
+  end;
 
   TFunctionParameter = record

branches/interpreter/interpreter4/interpreter.lpi

@@ -2 +2 @@
 <CONFIG>
   <ProjectOptions>
-    <Version Value="9"/>
+    <Version Value="10"/>
     <General>
       <Flags>
@@ -104 +104 @@
   </CompilerOptions>
   <Debugging>
-    <Exceptions Count="3">
+    <Exceptions Count="5">
       <Item1>
         <Name Value="EAbort"/>
@@ -114 +114 @@
         <Name Value="EFOpenError"/>
       </Item3>
+      <Item4>
+        <Name Value="RunError(101)"/>
+      </Item4>
+      <Item5>
+        <Name Value="Unknown"/>
+      </Item5>
     </Exceptions>
   </Debugging>