Changeset 99


Ignore:
Timestamp:
Feb 6, 2017, 12:11:54 AM (8 years ago)
Author:
chronos
Message:
  • Modified: Better parsing of expression and commands.
Location:
branches/interpreter
Files:
3 edited

Legend:

Unmodified
Added
Removed

  • branches/interpreter/Execute3.pas

    r98 r99  
    55uses
    66  Source3;
     7
     8type
     9  TVariableValue = record
     10    BaseType: TBaseType;
     11    case Integer of
     12      0: (ValueChar: Char);
     13      1: (ValueInteger: Integer);
     14      2: (ValueString: ShortString);
     15      3: (ValueBoolean: Boolean);
     16  end;
     17  PVariableValue = ^TVariableValue;
     18
     19  TVariableValues = record
     20    Items: array of TVariableValue;
     21  end;
     22
     23  { TExecutionContext }
     24
     25  TExecutionContext = record
     26    VariableValues: TVariableValues;
     27    procedure LoadFromVariables(Variables: PVariables);
     28  end;
     29  PExecutionContext = ^TExecutionContext;
     30
     31  { TExecutionContexts }
     32
     33  TExecutionContexts = record
     34    Items: array of TExecutionContext;
     35    function Last: PExecutionContext;
     36    procedure Add;
     37    procedure RemoveLast;
     38  end;
     39
     40var
     41  ExecutionContexts: TExecutionContexts;
    742
    843procedure ExecuteProgram(ProgramCode: PProgramCode);
    … …  
    4378  I: Integer;
    4479begin
     80  ExecutionContexts.Add;
     81  ExecutionContexts.Last^.LoadFromVariables(@Execution^.Func^.Variables);
    4582{  Execution^.Func^.Variables.Add(VariableCreate('Result', Execution^.Func^.ReturnType));
    4683  for I := 0 to Length(Execution^.Func^.Parameters.Items) - 1 do begin
    … …  
    5390}
    5491  ExecuteBeginEnd(@Execution^.Func^.BeginEnd);
     92  ExecutionContexts.RemoveLast;
    5593end;
    5694
    5795procedure ExecuteAssignment(Assignment: PAssignment);
     96var
     97  DestVariable: PVariableValue;
    5898begin
    59   case Assignment^.Destination^.DataType^.BaseType of
    60     btBoolean: Assignment^.Destination.ValueBoolean := ExecuteExpressionBoolean(@Assignment^.Source);
     99  DestVariable := @ExecutionContexts.Last^.VariableValues.Items[Assignment^.Destination^.Index];
     100  case DestVariable^.BaseType of
     101    btBoolean: DestVariable^.ValueBoolean := ExecuteExpressionBoolean(@Assignment^.Source);
    61102    //btChar: Assignment^.Destination.ValueBoolean := ExecuteExpressionChar(@Assignment^.Source);
    62103    //btString: Assignment^.Destination.ValueBoolean := ExecuteExpressionString(@Assignment^.Source);
    … …  
    78119procedure ExecuteProgram(ProgramCode: PProgramCode);
    79120begin
     121  SetLength(ExecutionContexts.Items, 1);
     122  ExecutionContexts.Last^.LoadFromVariables(@ProgramCode^.Variables);
    80123  ExecuteBeginEnd(@ProgramCode^.BeginEnd);
     124end;
     125
     126{ TExecutionContext }
     127
     128procedure TExecutionContext.LoadFromVariables(Variables: PVariables);
     129var
     130  I: Integer;
     131begin
     132  SetLength(VariableValues.Items, Length(Variables.Items));
     133  for I := 0 to Length(Variables.Items) - 1 do begin
     134    VariableValues.Items[I].BaseType := Variables.Items[I].DataType.BaseType;
     135  end;
     136end;
     137
     138{ TExecutionContexts }
     139
     140function TExecutionContexts.Last: PExecutionContext;
     141begin
     142  Result := @ExecutionContexts.Items[Length(ExecutionContexts.Items) - 1];
     143end;
     144
     145procedure TExecutionContexts.Add;
     146begin
     147  SetLength(Items, Length(Items) + 1);
     148end;
     149
     150procedure TExecutionContexts.RemoveLast;
     151begin
     152  SetLength(Items, Length(Items) - 1);
    81153end;
    82154

  • branches/interpreter/Parser3.pas

    r98 r99  
    2727function ParseExecution(Execution: PExecution): Boolean; forward;
    2828function ParseBeginEnd(BeginEnd: PBeginEnd): Boolean; forward;
     29function ParseGetValue(GetValue: PGetValue): Boolean; forward;
    2930
    3031
    … …  
    165166end;
    166167
     168function ParseConstant(out Constant: PConstant): Boolean;
     169var
     170  OldPos: Integer;
     171  Next: string;
     172begin
     173  OldPos := InputTextPos;
     174  Next := ReadNext;
     175  Constant := MainProgram^.Constants.GetByName(Next);
     176  if Constant <> nil then begin
     177    Result := True;
     178  end else begin
     179    Result := False;
     180    InputTextPos := OldPos;
     181  end;
     182end;
     183
    167184function ParseExpression(Expression: PExpression): Boolean;
    168185var
    … …  
    170187  OldPos: Integer;
    171188  R: Boolean;
     189  GetValue: TGetValue;
     190  Execution: TExecution;
    172191  Variable: PVariable;
    173192  SubExpression: TExpression;
    174   Execution: TExecution;
    175193begin
    176194  Result := True;
    … …  
    180198  if CheckNext('(') then begin
    181199    Expect('(');
    182     R := ParseExpression(@SubExpression);
     200    if ParseGetValue(@GetValue) then begin
     201      SetLength(Expression^.Items, Length(Expression^.Items) + 1);
     202      Expression^.Items[Length(Expression^.Items) - 1] := GetValue;
     203    end;
    183204    Expect(')');
    184205  end else
    … …  
    207228end;
    208229
     230function ParseGetValue(GetValue: PGetValue): Boolean;
     231var
     232  Variable: PVariable;
     233  Constant: PConstant;
     234  FunctionCall: TExecution;
     235  Expression: TExpression;
     236begin
     237  if ParseVariable(Variable) then begin
     238    GetValue^.Variable := Variable;
     239    GetValue^.ReadType := rtVariable;
     240  end else
     241  if ParseConstant(Constant) then begin
     242    GetValue^.Constant := Constant;
     243    GetValue^.ReadType := rtConstant;
     244  end else
     245  if ParseExecution(@FunctionCall) then begin
     246    GetValue^.FunctionCall := GetMem(SizeOf(TExecution));
     247    GetValue^.FunctionCall^ := FunctionCall;
     248    GetValue^.ReadType := rtFunctionCall;
     249  end else
     250  if ParseExpression(@Expression) then begin
     251    GetValue^.Expression := GetMem(SizeOf(TExpression));
     252    GetValue^.Expression^ := Expression;
     253    GetValue^.ReadType := rtExpression;
     254  end else
     255    ShowError('Expected value');
     256end;
     257
    209258function ParseAssignment: Boolean;
    210259var
    … …  
    216265    Assignment.Destination := Variable;
    217266    Expect(':=');
    218     ParseExpression(@Assignment.Source);
     267    ParseGetValue(@Assignment.Source);
    219268  end else begin
    220269    Result := False;
    … …  
    228277  Func: PFunction;
    229278  I: Integer;
    230   Expression: TExpression;
    231279begin
    232280  Result := True;
    … …  
    235283  Func := MainProgram.Functions.GetByName(Next);
    236284  if Func <> nil then begin
     285    SetLength(Execution^.Parameters.Items, Length(Func^.Parameters.Items));
    237286    if Length(Func^.Parameters.Items) > 0 then begin
    238287      Expect('(');
    239288      I := 0;
    240289      while I < Length(Func^.Parameters.Items) do begin
    241         ParseExpression(@Expression);
     290        ParseGetValue(@Execution^.Parameters.Items[I]);
    242291        if I < (Length(Func^.Parameters.Items) - 1) then Expect(',');
    243292        I := I + 1;
    … …  
    251300end;
    252301
    253 function ParseCommand: Boolean;
     302function ParseCommand(Command: PCommand): Boolean;
    254303var
    255304  IfThenElse: TIfThenElse;
    … …  
    257306  BeginEnd: TBeginEnd;
    258307  Execution: TExecution;
     308  Assignment: TAssignment;
    259309begin
    260310  Result := True;
    261311  if ParseBeginEnd(@BeginEnd) then begin
     312    Command^.BeginEnd := GetMem(SizeOf(TBeginEnd));
     313    Command^.BeginEnd^ := BeginEnd;
     314    Command^.CmdType := ctBeginEnd;
    262315  end else
    263316  if ParseAssignment then begin
     317    Command^.Assignment := GetMem(SizeOf(TAssignment));
     318    Command^.Assignment^ := Assignment;
     319    Command^.CmdType := ctAssignment;
    264320  end else
    265321  if ParseExecution(@Execution) then begin
     322    Command^.Execution := GetMem(SizeOf(TExecution));
     323    Command^.Execution^ := Execution;
     324    Command^.CmdType := ctExecution;
    266325  end else
    267326  if ParseIfThen(@IfThenElse) then begin
     327    Command^.IfThenElse := GetMem(SizeOf(TIfThenElse));
     328    Command^.IfThenElse^ := IfThenElse;
     329    Command^.CmdType := ctIfThenElse;
    268330  end else
    269331  if ParseWhileDo(@WhileDo) then begin
     332    Command^.WhileDo := GetMem(SizeOf(TWhileDo));
     333    Command^.WhileDo^ := WhileDo;
     334    Command^.CmdType := ctWhileDo;
    270335  end else Result := False;
    271336end;
    … …  
    278343    ParseExpression(@IfThenElse.Condition);
    279344    Expect('then');
    280     ParseCommand;
     345    ParseCommand(@IfThenElse^.DoThen);
    281346    if CheckNext('else') then begin
    282347      Expect('else');
    283       ParseCommand;
     348      ParseCommand(@IfThenElse^.DoElse);
    284349    end;
    285350  end else Result := False;
    … …  
    293358    ParseExpression(@WhileDo.Condition);
    294359    Expect('do');
    295     ParseCommand;
     360    ParseCommand(@WhileDo^.Command);
    296361  end else Result := False;
    297362end;
    298363
    299364function ParseBeginEnd(BeginEnd: PBeginEnd): Boolean;
     365var
     366  Command: TCommand;
    300367begin
    301368  if CheckNext('begin') then begin
    302369    Result := True;
    303370    Expect('begin');
     371    SetLength(BeginEnd^.Commands, 0);
    304372    repeat
    305       if ParseCommand then begin
     373      if ParseCommand(@Command) then begin
     374        BeginEnd^.Add;
     375        BeginEnd^.GetLast^ := Command;
    306376        Expect(';');
    307377      end else

  • branches/interpreter/Source3.pas

    r98 r99  
    66
    77type
     8  PBeginEnd = ^TBeginEnd;
     9  PAssignment = ^TAssignment;
     10  PVariable = ^TVariable;
     11  PConstant = ^TConstant;
     12  PIfThenElse = ^TIfThenElse;
     13  PWhileDo = ^TWhileDo;
     14  PExpression = ^TExpression;
     15  PExecution = ^TExecution;
     16
    817  TBaseType = (btBoolean, btInteger, btChar, btShortString, btArray);
    918
    … …  
    2635    Name: string;
    2736    DataType: PType;
    28     case Integer of
    29       0: (ValueChar: Char);
    30       1: (ValueInteger: Integer);
    31       2: (ValueString: ShortString);
    32       3: (ValueBoolean: Boolean);
    33   end;
    34   PVariable = ^TVariable;
     37    Index: Integer;
     38  end;
    3539
    3640  { TVariables }
    … …  
    4145    function GetByName(Name: string): PVariable;
    4246  end;
     47  PVariables = ^TVariables;
    4348
    4449  TConstant = record
    4550    Name: string;
    4651    DataType: PType;
    47     case Integer of
    48       0: (ValueChar: Char);
    49       1: (ValueInteger: Integer);
    50       2: (ValueString: ShortString);
    51       3: (ValueBoolean: Boolean);
    52   end;
    53   PConstant = ^TConstant;
     52    Index: Integer;
     53    case TBaseType of
     54      btChar: (ValueChar: Char);
     55      btInteger: (ValueInteger: Integer);
     56      btShortString: (ValueString: ShortString);
     57      btBoolean: (ValueBoolean: Boolean);
     58  end;
     59
     60  { TConstants }
     61
     62  TConstants = record
     63    Items: array of TConstant;
     64    procedure Add(Constant: TConstant);
     65    function GetByName(Name: string): PConstant;
     66  end;
     67  PConstants = ^TConstants;
    5468
    5569  TFunctionParameter = record
    … …  
    7286    CmdType: TCmdType;
    7387    Ptr: Pointer;
    74 {    case Integer of
    75       0: (WhileDo: TWhileDo);
    76       1: (IfThenElse: TIfThenElse);
    77       2: (BeginEnd: TBeginEnd);
    78       3: (Assignment: TAssignment);
    79       4: (Execution: TExecution);
    80  } end;
     88    case Integer of
     89      0: (WhileDo: PWhileDo);
     90      1: (IfThenElse: PIfThenElse);
     91      2: (BeginEnd: PBeginEnd);
     92      3: (Assignment: PAssignment);
     93      4: (Execution: PExecution);
     94  end;
    8195  PCommand = ^TCommand;
     96
     97  { TBeginEnd }
    8298
    8399  TBeginEnd = record
    84100    Commands: array of TCommand;
    85   end;
    86   PBeginEnd = ^TBeginEnd;
     101    procedure Add;
     102    function GetLast: PCommand;
     103  end;
     104
     105  TReadType = (rtVariable, rtConstant, rtExpression, rtFunctionCall);
     106  TGetValue = record
     107    ReadType: TReadType;
     108    case TReadType of
     109      rtVariable: (Variable: PVariable);
     110      rtConstant: (Constant: PConstant);
     111      rtExpression: (Expression: PExpression);
     112      rtFunctionCall: (FunctionCall: PExecution);
     113  end;
     114  PGetValue = ^TGetValue;
     115
     116  TExpOperand = (eoNone, eoAdd, eoSubtract, eoAnd, eoOr, eoNot);
    87117
    88118  TExpression = record
    89   end;
    90   PExpression = ^TExpression;
     119    Operand: TExpOperand;
     120    Items: array of TGetValue;
     121  end;
    91122
    92123  TAssignment = record
    93124    Destination: PVariable;
    94     Source: TExpression;
    95   end;
    96   PAssignment = ^TAssignment;
     125    Source: TGetValue;
     126  end;
    97127
    98128  TIfThenElse = record
    99     Condition: TExpression;
     129    Condition: TGetValue;
    100130    DoThen: TCommand;
    101131    DoElse: TCommand;
    102132  end;
    103   PIfThenElse = ^TIfThenElse;
    104133
    105134  TWhileDo = record
    106     Condition: TExpression;
     135    Condition: TGetValue;
    107136    Command: TCommand;
    108137  end;
    109   PWhileDo = ^TWhileDo;
    110138
    111139  { TFunction }
    … …  
    130158
    131159  TExecutionParams = record
    132     Items: array of TExpression;
     160    Items: array of TGetValue;
    133161  end;
    134162
    … …  
    137165    Parameters: TExecutionParams;
    138166  end;
    139   PExecution = ^TExecution;
    140167
    141168  TProgramCode = record
    142169    Name: string;
    143170    Variables: TVariables;
     171    Constants: TConstants;
    144172    Types: TTypes;
    145173    Functions: TFunctions;
    … …  
    180208end;
    181209
    182 { TVariables }
    183 
    184 procedure TVariables.Add(Variable: TVariable);
    185 begin
    186   SetLength(Items, Length(Items) + 1);
    187   Items[Length(Items) - 1] := Variable;
    188 end;
    189 
    190 function TVariables.GetByName(Name: string): PVariable;
     210{ TBeginEnd }
     211
     212procedure TBeginEnd.Add;
     213begin
     214  SetLength(Commands, Length(Commands) + 1);
     215end;
     216
     217function TBeginEnd.GetLast: PCommand;
     218begin
     219  Result := @Commands[Length(Commands) - 1];
     220end;
     221
     222{ TConstants }
     223
     224procedure TConstants.Add(Constant: TConstant);
     225begin
     226  SetLength(Items, Length(Items) + 1);
     227  Items[Length(Items) - 1] := Constant;
     228  Items[Length(Items) - 1].Index := Length(Items) - 1;
     229end;
     230
     231function TConstants.GetByName(Name: string): PConstant;
    191232var
    192233  I: Integer;
    … …  
    198239end;
    199240
    200 { TFunctionParameters }
    201 
    202 procedure TFunctionParameters.Add(Param: TFunctionParameter);
    203 begin
    204   SetLength(Items, Length(Items) + 1);
    205   Items[Length(Items) - 1] := Param;
    206 end;
    207 
    208 { TTypes }
    209 
    210 procedure TTypes.Add(DataType: TType);
    211 begin
    212   SetLength(Items, Length(Items) + 1);
    213   Items[Length(Items) - 1] := DataType;
    214 end;
    215 
    216 function TTypes.GetByName(Name: string): PType;
     241{ TVariables }
     242
     243procedure TVariables.Add(Variable: TVariable);
     244begin
     245  SetLength(Items, Length(Items) + 1);
     246  Items[Length(Items) - 1] := Variable;
     247  Items[Length(Items) - 1].Index := Length(Items) - 1;
     248end;
     249
     250function TVariables.GetByName(Name: string): PVariable;
    217251var
    218252  I: Integer;
    … …  
    224258end;
    225259
    226 function TTypes.GetLast: PType;
    227 begin
    228   Result := @Items[Length(Items) - 1];
    229 end;
    230 
    231 { TFunctions }
    232 
    233 procedure TFunctions.Add(Func: TFunction);
    234 begin
    235   SetLength(Items, Length(Items) + 1);
    236   Items[Length(Items) - 1] := Func;
    237 end;
    238 
    239 function TFunctions.GetByName(Name: string): PFunction;
     260{ TFunctionParameters }
     261
     262procedure TFunctionParameters.Add(Param: TFunctionParameter);
     263begin
     264  SetLength(Items, Length(Items) + 1);
     265  Items[Length(Items) - 1] := Param;
     266end;
     267
     268{ TTypes }
     269
     270procedure TTypes.Add(DataType: TType);
     271begin
     272  SetLength(Items, Length(Items) + 1);
     273  Items[Length(Items) - 1] := DataType;
     274end;
     275
     276function TTypes.GetByName(Name: string): PType;
    240277var
    241278  I: Integer;
    … …  
    247284end;
    248285
     286function TTypes.GetLast: PType;
     287begin
     288  Result := @Items[Length(Items) - 1];
     289end;
     290
     291{ TFunctions }
     292
     293procedure TFunctions.Add(Func: TFunction);
     294begin
     295  SetLength(Items, Length(Items) + 1);
     296  Items[Length(Items) - 1] := Func;
     297end;
     298
     299function TFunctions.GetByName(Name: string): PFunction;
     300var
     301  I: Integer;
     302begin
     303  I := 0;
     304  while (I < Length(Items)) and (Items[I].Name <> Name) do I := I + 1;
     305  if I < Length(Items) then Result := @Items[I]
     306    else Result := nil;
     307end;
     308
    249309function TFunctions.GetLast: PFunction;
    250310begin
Note: See TracChangeset for help on using the changeset viewer.