Changeset 207


Ignore:
Timestamp:
Apr 20, 2020, 11:31:59 PM (4 years ago)
Author:
chronos
Message:
  • Added: Optimizer class for implementation of various optimizations on AST.
  • Added: Transformation of repeat-until loop to while-do loop.
Location:
branches/interpreter2
Files:
1 added
11 edited

Legend:

Unmodified
Added
Removed

  • branches/interpreter2/UExecutor.pas

    r205 r207  
    104104    procedure ExecuteRepeatUntil(Block: TExecutorBlock; RepeatUntil: TRepeatUntil);
    105105    procedure ExecuteForToDo(Block: TExecutorBlock; ForToDo: TForToDo);
     106    procedure ExecuteContinue(Block: TExecutorBlock; ContinueCmd: TContinue);
     107    procedure ExecuteBreak(Block: TExecutorBlock; BreakCmd: TBreak);
    106108    procedure ExecuteBlock(ParentBlock: TExecutorBlock; Block: TBlock);
    107109    function ExecuteFunctionCall(Block: TExecutorBlock; FunctionCall: TFunctionCall): TValue;
    … …  
    435437  else if Command is TRepeatUntil then ExecuteRepeatUntil(Block, TRepeatUntil(Command))
    436438  else if Command is TForToDo then ExecuteForToDo(Block, TForToDo(Command))
     439  else if Command is TBreak then ExecuteBreak(Block, TBreak(Command))
     440  else if Command is TContinue then ExecuteContinue(Block, TContinue(Command))
     441  else if Command is TEmptyCommand then
    437442  else raise Exception.Create('Unsupported command type');
    438443end;
    … …  
    446451  if Value is TValueBoolean then begin
    447452    if TValueBoolean(Value).Value then ExecuteCommand(Block, IfThenElse.CommandThen)
    448       else ExecuteCommand(Block, IfThenElse.CommandElse);
     453      else begin
     454        if not (IfThenElse.CommandElse is TCommand) then
     455          ExecuteCommand(Block, IfThenElse.CommandElse);
     456      end;
    449457  end else raise Exception.Create('Expected boolean value.');
    450458  Value.Free;
    … …  
    497505  end;
    498506  Limit.Free;
     507end;
     508
     509procedure TExecutor.ExecuteContinue(Block: TExecutorBlock;
     510  ContinueCmd: TContinue);
     511begin
     512
     513end;
     514
     515procedure TExecutor.ExecuteBreak(Block: TExecutorBlock; BreakCmd: TBreak);
     516begin
     517
    499518end;
    500519

  • branches/interpreter2/UFormMain.lfm

    r206 r207  
    108108      OnExecute = AExitExecute
    109109    end
     110    object AOptimize: TAction
     111      Caption = 'Optimize'
     112      OnExecute = AOptimizeExecute
     113    end
    110114  end
    111115end

  • branches/interpreter2/UFormMain.pas

    r206 r207  
    1515  TFormMain = class(TForm)
    1616    ACompile: TAction;
     17    AOptimize: TAction;
    1718    AExit: TAction;
    1819    ARun: TAction;
    … …  
    4041    procedure AGeneratePascalExecute(Sender: TObject);
    4142    procedure AGeneratePhpExecute(Sender: TObject);
     43    procedure AOptimizeExecute(Sender: TObject);
    4244    procedure ARunExecute(Sender: TObject);
    4345    procedure FormActivate(Sender: TObject);
    … …  
    6668uses
    6769  UParser, UExecutor, UGeneratorPascal, UGeneratorPhp, UFormMessages, UFormSource,
    68   UGeneratorCSharp;
     70  UGeneratorCSharp, UOptimizer;
    6971
    7072{ TFormMain }
    … …  
    121123begin
    122124  ACompile.Execute;
     125  AOptimize.Execute;
    123126  MemoOutput.Lines.Clear;
    124127  if Assigned(Prog) then begin
    … …  
    137140begin
    138141  ACompile.Execute;
     142  AOptimize.Execute;
    139143  MemoOutput.Lines.Clear;
    140144  if Assigned(Prog) then begin
    … …  
    164168end;
    165169
     170procedure TFormMain.AOptimizeExecute(Sender: TObject);
     171var
     172  Optimizer: TOptimizer;
     173begin
     174  if Assigned(Prog) then begin
     175    Optimizer := TOptimizer.Create;
     176    Optimizer.Prog := Prog;
     177    Optimizer.Optimize;
     178    Optimizer.Free;
     179  end;
     180end;
     181
    166182procedure TFormMain.ARunExecute(Sender: TObject);
    167183var
    … …  
    169185begin
    170186  ACompile.Execute;
     187  //AOptimize.Execute;
    171188  MemoOutput.Lines.Clear;
    172189  if Assigned(Prog) then begin

  • branches/interpreter2/UGeneratorCSharp.pas

    r206 r207  
    3030    procedure GenerateExpressionOperation(Block: TBlock; Expression: TExpressionOperation);
    3131    procedure GenerateExpressionOperand(Block: TBlock; Expression: TExpressionOperand);
     32    procedure GenerateBreak(Block: TBlock; BreakCmd: TBreak);
     33    procedure GenerateContinue(Block: TBlock; ContinueCmd: TContinue);
    3234    procedure GenerateTypeRef(TypeRef: TType);
    3335    procedure GenerateValue(Value: TValue);
    … …  
    5052  else if Command is TRepeatUntil then GenerateRepeatUntil(Block, TRepeatUntil(Command))
    5153  else if Command is TForToDo then GenerateForToDo(Block, TForToDo(Command))
     54  else if Command is TBreak then GenerateBreak(Block, TBreak(Command))
     55  else if Command is TContinue then GenerateContinue(Block, TContinue(Command))
     56  else if Command is TEmptyCommand then
    5257  else raise Exception.Create('Unsupported command type');
    5358end;
    … …  
    5964  AddText(' ) ');
    6065  GenerateCommand(Block, IfThenElse.CommandThen);
    61   if Assigned(IfThenElse.CommandElse) then begin
     66  if Assigned(IfThenElse.CommandElse) and not (IfThenElse.CommandElse is TEmptyCommand) then begin
    6267    if Copy(Output, Length(Output), 1) <> '}' then AddText(';');
    6368    AddText(' else ');
    … …  
    165170    else raise Exception.Create('Unsupported exception operand type.');
    166171  end;
     172end;
     173
     174procedure TGeneratorCSharp.GenerateBreak(Block: TBlock; BreakCmd: TBreak);
     175begin
     176  AddText('break');
     177end;
     178
     179procedure TGeneratorCSharp.GenerateContinue(Block: TBlock;
     180  ContinueCmd: TContinue);
     181begin
     182  AddText('continue');
    167183end;
    168184

  • branches/interpreter2/UGeneratorPascal.pas

    r205 r207  
    2929    procedure GenerateExpressionOperation(Block: TBlock; Expression: TExpressionOperation);
    3030    procedure GenerateExpressionOperand(Block: TBlock; Expression: TExpressionOperand);
     31    procedure GenerateBreak(Block: TBlock; BreakCmd: TBreak);
     32    procedure GenerateContinue(Block: TBlock; ContinueCmd: TContinue);
    3133    procedure GenerateValue(Value: TValue);
    3234  public
    … …  
    4850  else if Command is TRepeatUntil then GenerateRepeatUntil(Block, TRepeatUntil(Command))
    4951  else if Command is TForToDo then GenerateForToDo(Block, TForToDo(Command))
     52  else if Command is TBreak then GenerateBreak(Block, TBreak(Command))
     53  else if Command is TContinue then GenerateContinue(Block, TContinue(Command))
     54  else if Command is TEmptyCommand then
    5055  else raise Exception.Create('Unsupported command type');
    5156end;
    … …  
    5762  AddText(' then ');
    5863  GenerateCommand(Block, IfThenElse.CommandThen);
    59   if Assigned(IfThenElse.CommandElse) then begin
     64  if Assigned(IfThenElse.CommandElse) and not (IfThenElse.CommandElse is TEmptyCommand) then begin
    6065    AddText(' else ');
    6166    GenerateCommand(Block, IfThenElse.CommandElse);
    … …  
    158163    else raise Exception.Create('Unsupported exception operand type.');
    159164  end;
     165end;
     166
     167procedure TGeneratorPascal.GenerateBreak(Block: TBlock; BreakCmd: TBreak);
     168begin
     169  AddText('break');
     170end;
     171
     172procedure TGeneratorPascal.GenerateContinue(Block: TBlock;
     173  ContinueCmd: TContinue);
     174begin
     175  AddText('continue');
    160176end;
    161177

  • branches/interpreter2/UGeneratorPhp.pas

    r206 r207  
    2929    procedure GenerateExpressionOperation(Block: TBlock; Expression: TExpressionOperation);
    3030    procedure GenerateExpressionOperand(Block: TBlock; Expression: TExpressionOperand);
     31    procedure GenerateBreak(Block: TBlock; BreakCmd: TBreak);
     32    procedure GenerateContinue(Block: TBlock; ContinueCmd: TContinue);
    3133    procedure GenerateValue(Value: TValue);
    3234  public
    … …  
    4850  else if Command is TRepeatUntil then GenerateRepeatUntil(Block, TRepeatUntil(Command))
    4951  else if Command is TForToDo then GenerateForToDo(Block, TForToDo(Command))
     52  else if Command is TBreak then GenerateBreak(Block, TBreak(Command))
     53  else if Command is TContinue then GenerateContinue(Block, TContinue(Command))
     54  else if Command is TEmptyCommand then
    5055  else raise Exception.Create('Unsupported command type');
    5156end;
    … …  
    5762  AddText(' ) ');
    5863  GenerateCommand(Block, IfThenElse.CommandThen);
    59   if Assigned(IfThenElse.CommandElse) then begin
     64  if Assigned(IfThenElse.CommandElse) and not (IfThenElse.CommandElse is TEmptyCommand) then begin
    6065    if Copy(Output, Length(Output), 1) <> '}' then AddText(';');
    6166    AddText(' else ');
    … …  
    8893  AddTextLine(') break;');
    8994  Indent := Indent - 1;
    90   AddTextLine('}');
     95  AddText('}');
    9196end;
    9297
    … …  
    166171    else raise Exception.Create('Unsupported exception operand type.');
    167172  end;
     173end;
     174
     175procedure TGeneratorPhp.GenerateBreak(Block: TBlock; BreakCmd: TBreak);
     176begin
     177  AddText('break');
     178end;
     179
     180procedure TGeneratorPhp.GenerateContinue(Block: TBlock; ContinueCmd: TContinue);
     181begin
     182  AddText('continue');
    168183end;
    169184

  • branches/interpreter2/UParser.pas

    r205 r207  
    3434    function ParseRepeatUntil(Block: TBlock; out RepeatUntil: TRepeatUntil): Boolean;
    3535    function ParseForToDo(Block: TBlock; out ForToDo: TForToDo): Boolean;
     36    function ParseBreak(Block: TBlock; out BreakCmd: TBreak): Boolean;
     37    function ParseContinue(Block: TBlock; out ContinueCmd: TContinue): Boolean;
    3638    procedure TokenizerError(Pos: TPoint; Text: string);
    3739    procedure InitSystemBlock(Block: TBlock);
    … …  
    121123  ForToDo: TForToDo;
    122124  RepeatUntil: TRepeatUntil;
     125  BreakCmd: TBreak;
     126  ContinueCmd: TContinue;
    123127begin
    124128  if ParseIfThenElse(Block, IfThenElse) then begin
    … …  
    149153    Result := True;
    150154    Command := Assignment;
    151   end else Result := False;
     155  end else
     156  if ParseBreak(Block, BreakCmd) then begin
     157    Result := True;
     158    Command := BreakCmd;
     159  end else
     160  if ParseContinue(Block, ContinueCmd) then begin
     161    Result := True;
     162    Command := ContinueCmd;
     163  end else
     164    Result := False;
    152165end;
    153166
    … …  
    563576end;
    564577
     578function TParser.ParseBreak(Block: TBlock; out BreakCmd: TBreak): Boolean;
     579begin
     580  Result := False;
     581  if Tokenizer.CheckNext('break', tkKeyword) then begin
     582    Tokenizer.Expect('break', tkKeyword);
     583    Result := True;
     584    BreakCmd := TBreak.Create;
     585  end;
     586end;
     587
     588function TParser.ParseContinue(Block: TBlock; out ContinueCmd: TContinue
     589  ): Boolean;
     590begin
     591  Result := False;
     592  if Tokenizer.CheckNext('continue', tkKeyword) then begin
     593    Tokenizer.Expect('continue', tkKeyword);
     594    Result := True;
     595    ContinueCmd := TContinue.Create;
     596  end;
     597end;
     598
    565599procedure TParser.TokenizerError(Pos: TPoint; Text: string);
    566600begin

  • branches/interpreter2/USource.pas

    r205 r207  
    1313  TBeginEnd = class;
    1414
     15  { TSourceNode }
     16
     17  TSourceNode = class
     18  private
     19    function GetNode(Index: Integer): TSourceNode; virtual;
     20    function GetNodesCount: Integer; virtual;
     21    procedure SetNode(Index: Integer; AValue: TSourceNode); virtual;
     22  public
     23    property NodesCount: Integer read GetNodesCount;
     24    property Nodes[Index: Integer]: TSourceNode read GetNode write SetNode;
     25  end;
     26
     27  { TSourceNodes }
     28
     29  TSourceNodes = class(TSourceNode)
     30  private
     31    function GetCount: Integer;
     32    function GetItem(Index: Integer): TObject;
     33    procedure SetItem(Index: Integer; AValue: TObject);
     34  public
     35    List: TObjectList;
     36    procedure Clear;
     37    function Add(AObject: TObject): Integer;
     38    constructor Create;
     39    destructor Destroy; override;
     40    property Items[Index: Integer]: TObject read GetItem write SetItem; default;
     41    property Count: Integer read GetCount;
     42  end;
     43
    1544  { TValue }
    1645
    … …  
    4473  { TType }
    4574
    46   TType = class
     75  TType = class(TSourceNode)
    4776    Name: string;
    4877    Functions: TFunctions;
    … …  
    5483  { TTypes }
    5584
    56   TTypes = class(TObjectList)
     85  TTypes = class(TSourceNodes)
    5786    function SearchByName(Name: string): TType;
    5887    function AddNew(Name: string): TType;
    5988  end;
    6089
    61   TVariable = class
     90  { TVariable }
     91
     92  TVariable = class(TSourceNode)
     93  private
     94    function GetNode(Index: Integer): TSourceNode; override;
     95    function GetNodesCount: Integer; override;
     96    procedure SetNode(Index: Integer; AValue: TSourceNode); override;
     97  public
    6298    Name: string;
    6399    TypeRef: TType;
    … …  
    66102  { TVariables }
    67103
    68   TVariables = class(TObjectList)
     104  TVariables = class(TSourceNodes)
    69105    function SearchByName(Name: string): TVariable;
    70106  end;
    71107
    72   TConstant = class
     108  { TConstant }
     109
     110  TConstant = class(TSourceNode)
     111  private
     112    function GetNode(Index: Integer): TSourceNode; override;
     113    function GetNodesCount: Integer; override;
     114    procedure SetNode(Index: Integer; AValue: TSourceNode); override;
     115  public
    73116    Name: string;
    74117    TypeRef: TType;
    … …  
    78121  { TConstants }
    79122
    80   TConstants = class(TObjectList)
     123  TConstants = class(TSourceNodes)
    81124    function SearchByName(Name: string): TConstant;
    82125    function AddNew(Name: string): TConstant;
    83126  end;
    84127
    85   TFunctionParameter = class
     128  TFunctionParameter = class(TSourceNode)
    86129    Name: string;
    87130    TypeRef: TType;
    … …  
    90133  { TFunctionParameters }
    91134
    92   TFunctionParameters = class(TObjectList)
     135  TFunctionParameters = class(TSourceNodes)
    93136    function SearchByName(Name: string): TFunctionParameter;
    94137    function AddNew(Name: string; TypeRef: TType): TFunctionParameter;
    … …  
    97140  { TFunction }
    98141
    99   TFunction = class
     142  TFunction = class(TSourceNode)
     143  private
     144    function GetNode(Index: Integer): TSourceNode; override;
     145    function GetNodesCount: Integer; override;
     146    procedure SetNode(Index: Integer; AValue: TSourceNode); override;
     147  public
    100148    Name: string;
    101149    InternalName: string;
    … …  
    109157  { TFunctions }
    110158
    111   TFunctions = class(TObjectList)
     159  TFunctions = class(TSourceNodes)
    112160    function SearchByName(Name: string): TFunction;
    113161    function AddNew(Name: string): TFunction;
    114162  end;
    115163
    116   TCommand = class
    117   end;
    118 
    119   TCommands = class(TObjectList)
     164  TCommand = class(TSourceNode)
     165  end;
     166
     167  TCommands = class(TSourceNodes)
     168  end;
     169
     170  TEmptyCommand = class(TCommand)
    120171  end;
    121172
    … …  
    123174
    124175  TFunctionCall = class(TCommand)
     176  private
     177    function GetNode(Index: Integer): TSourceNode; override;
     178    function GetNodesCount: Integer; override;
     179    procedure SetNode(Index: Integer; AValue: TSourceNode); override;
     180  public
    125181    FunctionDef: TFunction;
    126182    Params: TExpressions;
    … …  
    132188
    133189  TBeginEnd = class(TCommand)
     190  private
     191    function GetNode(Index: Integer): TSourceNode; override;
     192    function GetNodesCount: Integer; override;
     193    procedure SetNode(Index: Integer; AValue: TSourceNode); override;
     194  public
    134195    Commands: TCommands;
    135196    procedure Clear;
    … …  
    143204  { TExpression }
    144205
    145   TExpression = class
     206  TExpression = class(TSourceNode)
    146207    function GetType: TType; virtual;
    147208  end;
    … …  
    150211
    151212  TExpressionOperation = class(TExpression)
     213  private
     214    function GetNode(Index: Integer): TSourceNode; override;
     215    function GetNodesCount: Integer; override;
     216    procedure SetNode(Index: Integer; AValue: TSourceNode); override;
     217  public
    152218    TypeRef: TType;
    153219    Operation: TExpressionOperator;
    … …  
    163229
    164230  TExpressionOperand = class(TExpression)
     231  private
     232    function GetNode(Index: Integer): TSourceNode; override;
     233    function GetNodesCount: Integer; override;
     234    procedure SetNode(Index: Integer; AValue: TSourceNode); override;
     235  public
    165236    OperandType: TExpressionOperandType;
    166237    VariableRef: TVariable;
    … …  
    173244  end;
    174245
    175   TExpressions = class(TObjectList)
     246  TExpressions = class(TSourceNodes)
    176247  end;
    177248
    … …  
    179250
    180251  TAssignment = class(TCommand)
     252  private
     253    function GetNode(Index: Integer): TSourceNode; override;
     254    function GetNodesCount: Integer; override;
     255    procedure SetNode(Index: Integer; AValue: TSourceNode); override;
     256  public
    181257    Variable: TVariable;
    182258    Expression: TExpression;
    … …  
    188264
    189265  TIfThenElse = class(TCommand)
     266  private
     267    function GetNode(Index: Integer): TSourceNode; override;
     268    function GetNodesCount: Integer; override;
     269    procedure SetNode(Index: Integer; AValue: TSourceNode); override;
     270  public
    190271    Expression: TExpression;
    191272    CommandThen: TCommand;
    … …  
    198279
    199280  TWhileDo = class(TCommand)
     281  private
     282    function GetNode(Index: Integer): TSourceNode; override;
     283    function GetNodesCount: Integer; override;
     284    procedure SetNode(Index: Integer; AValue: TSourceNode); override;
     285  public
    200286    Expression: TExpression;
    201287    Command: TCommand;
    … …  
    207293
    208294  TRepeatUntil = class(TCommand)
     295  private
     296    function GetNode(Index: Integer): TSourceNode; override;
     297    function GetNodesCount: Integer; override;
     298    procedure SetNode(Index: Integer; AValue: TSourceNode); override;
     299  public
    209300    Expression: TExpression;
    210301    Commands: TCommands;
    … …  
    213304  end;
    214305
     306  TBreak = class(TCommand)
     307  end;
     308
     309  TContinue = class(TCommand)
     310  end;
     311
    215312  { TForToDo }
    216313
    217314  TForToDo = class(TCommand)
     315  private
     316    function GetNode(Index: Integer): TSourceNode; override;
     317    function GetNodesCount: Integer; override;
     318    procedure SetNode(Index: Integer; AValue: TSourceNode); override;
     319  public
    218320    VariableRef: TVariable;
    219321    ExpressionFrom: TExpression;
    … …  
    226328  { TBlock }
    227329
    228   TBlock = class
     330  TBlock = class(TSourceNode)
     331  private
     332    function GetNode(Index: Integer): TSourceNode; override;
     333    function GetNodesCount: Integer; override;
     334    procedure SetNode(Index: Integer; AValue: TSourceNode); override;
     335  public
    229336    Parent: TBlock;
    230337    Variables: TVariables;
    … …  
    244351  { TProgram }
    245352
    246   TProgram = class
     353  TProgram = class(TSourceNode)
     354  private
     355    function GetNode(Index: Integer): TSourceNode; override;
     356    function GetNodesCount: Integer; override;
     357    procedure SetNode(Index: Integer; AValue: TSourceNode); override;
     358  public
    247359    Name: string;
    248360    SystemBlock: TBlock;
    … …  
    253365  end;
    254366
     367
    255368implementation
    256369
     370resourcestring
     371  SIndexError = 'Index error';
     372
     373{ TSourceNodes }
     374
     375function TSourceNodes.GetCount: Integer;
     376begin
     377  Result := List.Count;
     378end;
     379
     380function TSourceNodes.GetItem(Index: Integer): TObject;
     381begin
     382  Result := List[Index];
     383end;
     384
     385procedure TSourceNodes.SetItem(Index: Integer; AValue: TObject);
     386begin
     387  List[Index] := AValue;
     388end;
     389
     390procedure TSourceNodes.Clear;
     391begin
     392  List.Clear;
     393end;
     394
     395function TSourceNodes.Add(AObject: TObject): Integer;
     396begin
     397  Result := List.Add(AObject);
     398end;
     399
     400constructor TSourceNodes.Create;
     401begin
     402  List := TObjectList.Create;
     403end;
     404
     405destructor TSourceNodes.Destroy;
     406begin
     407  List.Free;
     408  inherited Destroy;
     409end;
     410
     411{ TVariable }
     412
     413function TVariable.GetNode(Index: Integer): TSourceNode;
     414begin
     415  if Index = 0 then Result := TypeRef
     416  else raise Exception.Create(SIndexError);
     417end;
     418
     419function TVariable.GetNodesCount: Integer;
     420begin
     421  Result := 1;
     422end;
     423
     424procedure TVariable.SetNode(Index: Integer; AValue: TSourceNode);
     425begin
     426  if Index = 0 then TypeRef := TType(AValue)
     427  else raise Exception.Create(SIndexError);
     428end;
     429
     430{ TConstant }
     431
     432function TConstant.GetNode(Index: Integer): TSourceNode;
     433begin
     434  if Index = 0 then Result := TypeRef
     435  else raise Exception.Create(SIndexError);
     436end;
     437
     438function TConstant.GetNodesCount: Integer;
     439begin
     440  Result := 1;
     441end;
     442
     443procedure TConstant.SetNode(Index: Integer; AValue: TSourceNode);
     444begin
     445  if Index = 0 then TypeRef := TType(AValue)
     446  else raise Exception.Create(SIndexError);
     447end;
     448
     449{ TSourceNode }
     450
     451function TSourceNode.GetNode(Index: Integer): TSourceNode;
     452begin
     453  raise Exception.Create(SIndexError);
     454end;
     455
     456function TSourceNode.GetNodesCount: Integer;
     457begin
     458  Result := 0;
     459end;
     460
     461procedure TSourceNode.SetNode(Index: Integer; AValue: TSourceNode);
     462begin
     463  raise Exception.Create(SIndexError);
     464end;
     465
    257466{ TRepeatUntil }
     467
     468function TRepeatUntil.GetNode(Index: Integer): TSourceNode;
     469begin
     470  if Index = 0 then Result := Expression
     471  else if Index = 1 then Result := Commands
     472  else raise Exception.Create(SIndexError);
     473end;
     474
     475function TRepeatUntil.GetNodesCount: Integer;
     476begin
     477  Result := 2;
     478end;
     479
     480procedure TRepeatUntil.SetNode(Index: Integer; AValue: TSourceNode);
     481begin
     482  if Index = 0 then Expression := TExpression(AValue)
     483  else if Index = 1 then Commands := TCommands(AValue)
     484  else raise Exception.Create(SIndexError);
     485end;
    258486
    259487constructor TRepeatUntil.Create;
    … …  
    303531{ TForToDo }
    304532
     533function TForToDo.GetNode(Index: Integer): TSourceNode;
     534begin
     535  if Index = 0 then Result := VariableRef
     536  else if Index = 1 then Result := ExpressionFrom
     537  else if Index = 2 then Result := ExpressionTo
     538  else if Index = 3 then Result := Command
     539  else raise Exception.Create(SIndexError);
     540end;
     541
     542function TForToDo.GetNodesCount: Integer;
     543begin
     544  Result := 4;
     545end;
     546
     547procedure TForToDo.SetNode(Index: Integer; AValue: TSourceNode);
     548begin
     549  if Index = 0 then VariableRef := TVariable(AValue)
     550  else if Index = 1 then ExpressionFrom := TExpression(AValue)
     551  else if Index = 2 then ExpressionTo := TExpression(AValue)
     552  else if Index = 3 then Command := TCommand(AValue)
     553  else raise Exception.Create(SIndexError);
     554end;
     555
    305556constructor TForToDo.Create;
    306557begin
    307558  ExpressionFrom := TExpression.Create;
    308559  ExpressionTo := TExpression.Create;
    309   Command := TCommand.Create;
     560  Command := TEmptyCommand.Create;
    310561end;
    311562
    … …  
    326577
    327578{ TExpressionOperand }
     579
     580function TExpressionOperand.GetNode(Index: Integer): TSourceNode;
     581begin
     582  if Index = 0 then begin
     583    case OperandType of
     584      otConstantDirect: Result := ConstantDirect;
     585      otConstantRef: Result := ConstantRef;
     586      otFunctionCall: Result := FunctionCall;
     587      otVariableRef: Result := VariableRef;
     588    end;
     589  end
     590  else raise Exception.Create(SIndexError);
     591end;
     592
     593function TExpressionOperand.GetNodesCount: Integer;
     594begin
     595  Result := 1;
     596end;
     597
     598procedure TExpressionOperand.SetNode(Index: Integer; AValue: TSourceNode);
     599begin
     600  if Index = 0 then begin
     601    case OperandType of
     602      otConstantDirect: ConstantDirect := TConstant(AValue);
     603      otConstantRef: ConstantRef := TConstant(AValue);
     604      otFunctionCall: FunctionCall := TFunctionCall(AValue);
     605      otVariableRef: VariableRef := TVariable(AValue);
     606    end;
     607  end
     608  else raise Exception.Create(SIndexError);
     609end;
    328610
    329611function TExpressionOperand.GetType: TType;
    … …  
    367649{ TFunction }
    368650
     651function TFunction.GetNode(Index: Integer): TSourceNode;
     652begin
     653  if Index = 0 then Result := BeginEnd
     654  else if Index = 1 then Result := Params
     655  else if Index = 2 then Result := ResultType
     656  else raise Exception.Create(SIndexError);
     657end;
     658
     659function TFunction.GetNodesCount: Integer;
     660begin
     661  Result := 3;
     662end;
     663
     664procedure TFunction.SetNode(Index: Integer; AValue: TSourceNode);
     665begin
     666  if Index = 0 then BeginEnd := TBeginEnd(AValue)
     667  else if Index = 1 then Params := TFunctionParameters(AValue)
     668  else if Index = 2 then ResultType := TType(AValue)
     669  else raise Exception.Create(SIndexError);
     670end;
     671
    369672constructor TFunction.Create;
    370673begin
    … …  
    414717{ TExpressionOperation }
    415718
     719function TExpressionOperation.GetNode(Index: Integer): TSourceNode;
     720begin
     721  Result := TSourceNode(Items[Index]);
     722end;
     723
     724function TExpressionOperation.GetNodesCount: Integer;
     725begin
     726  Result := Items.Count;
     727end;
     728
     729procedure TExpressionOperation.SetNode(Index: Integer; AValue: TSourceNode);
     730begin
     731  Items[Index] := AValue;
     732end;
     733
    416734constructor TExpressionOperation.Create;
    417735begin
    … …  
    431749
    432750{ TAssignment }
     751
     752function TAssignment.GetNode(Index: Integer): TSourceNode;
     753begin
     754  if Index = 0 then Result := Expression
     755  else if Index = 1 then Result := Variable
     756  else raise Exception.Create(SIndexError);
     757end;
     758
     759function TAssignment.GetNodesCount: Integer;
     760begin
     761  Result := 2;
     762end;
     763
     764procedure TAssignment.SetNode(Index: Integer; AValue: TSourceNode);
     765begin
     766  if Index = 0 then Expression := TExpression(AValue)
     767  else if Index = 1 then Variable := TVariable(AValue)
     768  else raise Exception.Create(SIndexError);
     769end;
    433770
    434771constructor TAssignment.Create;
    … …  
    447784{ TIfThenElse }
    448785
     786function TIfThenElse.GetNode(Index: Integer): TSourceNode;
     787begin
     788  if Index = 0 then Result := Expression
     789  else if Index = 1 then Result := CommandElse
     790  else if Index = 2 then Result := CommandThen
     791  else raise Exception.Create(SIndexError);
     792end;
     793
     794function TIfThenElse.GetNodesCount: Integer;
     795begin
     796  Result := 3;
     797end;
     798
     799procedure TIfThenElse.SetNode(Index: Integer; AValue: TSourceNode);
     800begin
     801  if Index = 0 then Expression := TExpression(AValue)
     802  else if Index = 1 then CommandElse := TCommand(AValue)
     803  else if Index = 2 then CommandThen := TCommand(AValue)
     804  else raise Exception.Create(SIndexError);
     805end;
     806
    449807constructor TIfThenElse.Create;
    450808begin
    451809  Expression := TExpression.Create;
    452   CommandThen := TCommand.Create;
    453   CommandElse := TCommand.Create;
     810  CommandThen := TEmptyCommand.Create;
     811  CommandElse := TEmptyCommand.Create;
    454812end;
    455813
    … …  
    464822{ TWhileDo }
    465823
     824function TWhileDo.GetNode(Index: Integer): TSourceNode;
     825begin
     826  Result:=inherited GetNode(Index);
     827end;
     828
     829function TWhileDo.GetNodesCount: Integer;
     830begin
     831  Result:=inherited GetNodesCount;
     832end;
     833
     834procedure TWhileDo.SetNode(Index: Integer; AValue: TSourceNode);
     835begin
     836  inherited SetNode(Index, AValue);
     837end;
     838
    466839constructor TWhileDo.Create;
    467840begin
    468841  Expression := TExpression.Create;
    469   Command := TCommand.Create;
     842  Command := TEmptyCommand.Create;
    470843end;
    471844
    … …  
    478851
    479852{ TFunctionCall }
     853
     854function TFunctionCall.GetNode(Index: Integer): TSourceNode;
     855begin
     856  if Index = 0 then Result := FunctionDef
     857  else if Index = 1 then Result := Params
     858  else raise Exception.Create(SIndexError);
     859end;
     860
     861function TFunctionCall.GetNodesCount: Integer;
     862begin
     863  Result := 2;
     864end;
     865
     866procedure TFunctionCall.SetNode(Index: Integer; AValue: TSourceNode);
     867begin
     868  if Index = 0 then FunctionDef := TFunction(AValue)
     869  else if Index = 1 then Params := TExpressions(AValue)
     870  else raise Exception.Create(SIndexError);
     871end;
    480872
    481873constructor TFunctionCall.Create;
    … …  
    541933
    542934{ TBlock }
     935
     936function TBlock.GetNode(Index: Integer): TSourceNode;
     937begin
     938  if Index = 0 then Result := BeginEnd
     939  else if Index = 1 then Result := Types
     940  else if Index = 2 then Result := Variables
     941  else if Index = 3 then Result := Constants
     942  else if Index = 4 then Result := Functions
     943  else raise Exception.Create(SIndexError);
     944end;
     945
     946function TBlock.GetNodesCount: Integer;
     947begin
     948  Result := 5;
     949end;
     950
     951procedure TBlock.SetNode(Index: Integer; AValue: TSourceNode);
     952begin
     953  if Index = 0 then BeginEnd := TBeginEnd(AValue)
     954  else if Index = 1 then Types := TTypes(AValue)
     955  else if Index = 2 then Variables := TVariables(AValue)
     956  else if Index = 3 then Constants := TConstants(AValue)
     957  else if Index = 4 then Functions := TFunctions(AValue)
     958  else raise Exception.Create(SIndexError);
     959end;
    543960
    544961procedure TBlock.Clear;
    … …  
    5991016{ TBeginEnd }
    6001017
     1018function TBeginEnd.GetNode(Index: Integer): TSourceNode;
     1019begin
     1020  if Index = 0 then Result := Commands
     1021  else raise Exception.Create(SIndexError);
     1022end;
     1023
     1024function TBeginEnd.GetNodesCount: Integer;
     1025begin
     1026  Result := 1;
     1027end;
     1028
     1029procedure TBeginEnd.SetNode(Index: Integer; AValue: TSourceNode);
     1030begin
     1031  if Index = 0 then Commands := TCommands(AValue)
     1032  else raise Exception.Create(SIndexError);
     1033end;
     1034
    6011035procedure TBeginEnd.Clear;
    6021036begin
    … …  
    6161050
    6171051{ TProgram }
     1052
     1053function TProgram.GetNode(Index: Integer): TSourceNode;
     1054begin
     1055  if Index = 0 then Result := Block
     1056  else raise Exception.Create(SIndexError);
     1057end;
     1058
     1059function TProgram.GetNodesCount: Integer;
     1060begin
     1061  Result := 1;
     1062end;
     1063
     1064procedure TProgram.SetNode(Index: Integer; AValue: TSourceNode);
     1065begin
     1066  if Index = 0 then Block := TBlock(AValue)
     1067  else raise Exception.Create(SIndexError);
     1068end;
    6181069
    6191070procedure TProgram.Clear;

  • branches/interpreter2/UTokenizer.pas

    r205 r207  
    149149  (Text = 'var') or (Text = 'const') or (Text = 'if') or (Text = 'then') or
    150150  (Text = 'else') or (Text = 'while') or (Text = 'do') or (Text = 'for') or
    151   (Text = 'to') or (Text = 'repeat') or (Text = 'until');
     151  (Text = 'to') or (Text = 'repeat') or (Text = 'until') or (Text = 'break') or
     152  (Text = 'continue');
    152153end;
    153154

  • branches/interpreter2/interpreter.lpi

    r206 r207  
    7272      </Item2>
    7373    </RequiredPackages>
    74     <Units Count="13">
     74    <Units Count="14">
    7575      <Unit0>
    7676        <Filename Value="interpreter.lpr"/>
    … …  
    124124        <IsPartOfProject Value="True"/>
    125125        <ComponentName Value="FormMessages"/>
     126        <HasResources Value="True"/>
    126127        <ResourceBaseClass Value="Form"/>
    127128      </Unit11>
    … …  
    130131        <IsPartOfProject Value="True"/>
    131132        <ComponentName Value="FormSource"/>
     133        <HasResources Value="True"/>
    132134        <ResourceBaseClass Value="Form"/>
    133135      </Unit12>
     136      <Unit13>
     137        <Filename Value="UOptimizer.pas"/>
     138        <IsPartOfProject Value="True"/>
     139      </Unit13>
    134140    </Units>
    135141  </ProjectOptions>

  • branches/interpreter2/interpreter.lpr

    r206 r207  
    1010  Forms, UFormMain, UParser, UTokenizer, USource, UExecutor, UInterpreter,
    1111  UGeneratorPascal, UGeneratorPhp, UGenerator, UGeneratorCSharp, UFormMessages,
    12   UFormSource
     12  UFormSource, UOptimizer
    1313  { you can add units after this };
    1414
Note: See TracChangeset for help on using the changeset viewer.