- Timestamp:
- Apr 20, 2020, 11:31:59 PM (5 years ago)
- Location:
- branches/interpreter2
- Files:
-
- 1 added
- 11 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/interpreter2/UExecutor.pas
r205 r207 104 104 procedure ExecuteRepeatUntil(Block: TExecutorBlock; RepeatUntil: TRepeatUntil); 105 105 procedure ExecuteForToDo(Block: TExecutorBlock; ForToDo: TForToDo); 106 procedure ExecuteContinue(Block: TExecutorBlock; ContinueCmd: TContinue); 107 procedure ExecuteBreak(Block: TExecutorBlock; BreakCmd: TBreak); 106 108 procedure ExecuteBlock(ParentBlock: TExecutorBlock; Block: TBlock); 107 109 function ExecuteFunctionCall(Block: TExecutorBlock; FunctionCall: TFunctionCall): TValue; … … 435 437 else if Command is TRepeatUntil then ExecuteRepeatUntil(Block, TRepeatUntil(Command)) 436 438 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 437 442 else raise Exception.Create('Unsupported command type'); 438 443 end; … … 446 451 if Value is TValueBoolean then begin 447 452 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; 449 457 end else raise Exception.Create('Expected boolean value.'); 450 458 Value.Free; … … 497 505 end; 498 506 Limit.Free; 507 end; 508 509 procedure TExecutor.ExecuteContinue(Block: TExecutorBlock; 510 ContinueCmd: TContinue); 511 begin 512 513 end; 514 515 procedure TExecutor.ExecuteBreak(Block: TExecutorBlock; BreakCmd: TBreak); 516 begin 517 499 518 end; 500 519 -
branches/interpreter2/UFormMain.lfm
r206 r207 108 108 OnExecute = AExitExecute 109 109 end 110 object AOptimize: TAction 111 Caption = 'Optimize' 112 OnExecute = AOptimizeExecute 113 end 110 114 end 111 115 end -
branches/interpreter2/UFormMain.pas
r206 r207 15 15 TFormMain = class(TForm) 16 16 ACompile: TAction; 17 AOptimize: TAction; 17 18 AExit: TAction; 18 19 ARun: TAction; … … 40 41 procedure AGeneratePascalExecute(Sender: TObject); 41 42 procedure AGeneratePhpExecute(Sender: TObject); 43 procedure AOptimizeExecute(Sender: TObject); 42 44 procedure ARunExecute(Sender: TObject); 43 45 procedure FormActivate(Sender: TObject); … … 66 68 uses 67 69 UParser, UExecutor, UGeneratorPascal, UGeneratorPhp, UFormMessages, UFormSource, 68 UGeneratorCSharp ;70 UGeneratorCSharp, UOptimizer; 69 71 70 72 { TFormMain } … … 121 123 begin 122 124 ACompile.Execute; 125 AOptimize.Execute; 123 126 MemoOutput.Lines.Clear; 124 127 if Assigned(Prog) then begin … … 137 140 begin 138 141 ACompile.Execute; 142 AOptimize.Execute; 139 143 MemoOutput.Lines.Clear; 140 144 if Assigned(Prog) then begin … … 164 168 end; 165 169 170 procedure TFormMain.AOptimizeExecute(Sender: TObject); 171 var 172 Optimizer: TOptimizer; 173 begin 174 if Assigned(Prog) then begin 175 Optimizer := TOptimizer.Create; 176 Optimizer.Prog := Prog; 177 Optimizer.Optimize; 178 Optimizer.Free; 179 end; 180 end; 181 166 182 procedure TFormMain.ARunExecute(Sender: TObject); 167 183 var … … 169 185 begin 170 186 ACompile.Execute; 187 //AOptimize.Execute; 171 188 MemoOutput.Lines.Clear; 172 189 if Assigned(Prog) then begin -
branches/interpreter2/UGeneratorCSharp.pas
r206 r207 30 30 procedure GenerateExpressionOperation(Block: TBlock; Expression: TExpressionOperation); 31 31 procedure GenerateExpressionOperand(Block: TBlock; Expression: TExpressionOperand); 32 procedure GenerateBreak(Block: TBlock; BreakCmd: TBreak); 33 procedure GenerateContinue(Block: TBlock; ContinueCmd: TContinue); 32 34 procedure GenerateTypeRef(TypeRef: TType); 33 35 procedure GenerateValue(Value: TValue); … … 50 52 else if Command is TRepeatUntil then GenerateRepeatUntil(Block, TRepeatUntil(Command)) 51 53 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 52 57 else raise Exception.Create('Unsupported command type'); 53 58 end; … … 59 64 AddText(' ) '); 60 65 GenerateCommand(Block, IfThenElse.CommandThen); 61 if Assigned(IfThenElse.CommandElse) then begin66 if Assigned(IfThenElse.CommandElse) and not (IfThenElse.CommandElse is TEmptyCommand) then begin 62 67 if Copy(Output, Length(Output), 1) <> '}' then AddText(';'); 63 68 AddText(' else '); … … 165 170 else raise Exception.Create('Unsupported exception operand type.'); 166 171 end; 172 end; 173 174 procedure TGeneratorCSharp.GenerateBreak(Block: TBlock; BreakCmd: TBreak); 175 begin 176 AddText('break'); 177 end; 178 179 procedure TGeneratorCSharp.GenerateContinue(Block: TBlock; 180 ContinueCmd: TContinue); 181 begin 182 AddText('continue'); 167 183 end; 168 184 -
branches/interpreter2/UGeneratorPascal.pas
r205 r207 29 29 procedure GenerateExpressionOperation(Block: TBlock; Expression: TExpressionOperation); 30 30 procedure GenerateExpressionOperand(Block: TBlock; Expression: TExpressionOperand); 31 procedure GenerateBreak(Block: TBlock; BreakCmd: TBreak); 32 procedure GenerateContinue(Block: TBlock; ContinueCmd: TContinue); 31 33 procedure GenerateValue(Value: TValue); 32 34 public … … 48 50 else if Command is TRepeatUntil then GenerateRepeatUntil(Block, TRepeatUntil(Command)) 49 51 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 50 55 else raise Exception.Create('Unsupported command type'); 51 56 end; … … 57 62 AddText(' then '); 58 63 GenerateCommand(Block, IfThenElse.CommandThen); 59 if Assigned(IfThenElse.CommandElse) then begin64 if Assigned(IfThenElse.CommandElse) and not (IfThenElse.CommandElse is TEmptyCommand) then begin 60 65 AddText(' else '); 61 66 GenerateCommand(Block, IfThenElse.CommandElse); … … 158 163 else raise Exception.Create('Unsupported exception operand type.'); 159 164 end; 165 end; 166 167 procedure TGeneratorPascal.GenerateBreak(Block: TBlock; BreakCmd: TBreak); 168 begin 169 AddText('break'); 170 end; 171 172 procedure TGeneratorPascal.GenerateContinue(Block: TBlock; 173 ContinueCmd: TContinue); 174 begin 175 AddText('continue'); 160 176 end; 161 177 -
branches/interpreter2/UGeneratorPhp.pas
r206 r207 29 29 procedure GenerateExpressionOperation(Block: TBlock; Expression: TExpressionOperation); 30 30 procedure GenerateExpressionOperand(Block: TBlock; Expression: TExpressionOperand); 31 procedure GenerateBreak(Block: TBlock; BreakCmd: TBreak); 32 procedure GenerateContinue(Block: TBlock; ContinueCmd: TContinue); 31 33 procedure GenerateValue(Value: TValue); 32 34 public … … 48 50 else if Command is TRepeatUntil then GenerateRepeatUntil(Block, TRepeatUntil(Command)) 49 51 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 50 55 else raise Exception.Create('Unsupported command type'); 51 56 end; … … 57 62 AddText(' ) '); 58 63 GenerateCommand(Block, IfThenElse.CommandThen); 59 if Assigned(IfThenElse.CommandElse) then begin64 if Assigned(IfThenElse.CommandElse) and not (IfThenElse.CommandElse is TEmptyCommand) then begin 60 65 if Copy(Output, Length(Output), 1) <> '}' then AddText(';'); 61 66 AddText(' else '); … … 88 93 AddTextLine(') break;'); 89 94 Indent := Indent - 1; 90 AddText Line('}');95 AddText('}'); 91 96 end; 92 97 … … 166 171 else raise Exception.Create('Unsupported exception operand type.'); 167 172 end; 173 end; 174 175 procedure TGeneratorPhp.GenerateBreak(Block: TBlock; BreakCmd: TBreak); 176 begin 177 AddText('break'); 178 end; 179 180 procedure TGeneratorPhp.GenerateContinue(Block: TBlock; ContinueCmd: TContinue); 181 begin 182 AddText('continue'); 168 183 end; 169 184 -
branches/interpreter2/UParser.pas
r205 r207 34 34 function ParseRepeatUntil(Block: TBlock; out RepeatUntil: TRepeatUntil): Boolean; 35 35 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; 36 38 procedure TokenizerError(Pos: TPoint; Text: string); 37 39 procedure InitSystemBlock(Block: TBlock); … … 121 123 ForToDo: TForToDo; 122 124 RepeatUntil: TRepeatUntil; 125 BreakCmd: TBreak; 126 ContinueCmd: TContinue; 123 127 begin 124 128 if ParseIfThenElse(Block, IfThenElse) then begin … … 149 153 Result := True; 150 154 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; 152 165 end; 153 166 … … 563 576 end; 564 577 578 function TParser.ParseBreak(Block: TBlock; out BreakCmd: TBreak): Boolean; 579 begin 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; 586 end; 587 588 function TParser.ParseContinue(Block: TBlock; out ContinueCmd: TContinue 589 ): Boolean; 590 begin 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; 597 end; 598 565 599 procedure TParser.TokenizerError(Pos: TPoint; Text: string); 566 600 begin -
branches/interpreter2/USource.pas
r205 r207 13 13 TBeginEnd = class; 14 14 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 15 44 { TValue } 16 45 … … 44 73 { TType } 45 74 46 TType = class 75 TType = class(TSourceNode) 47 76 Name: string; 48 77 Functions: TFunctions; … … 54 83 { TTypes } 55 84 56 TTypes = class(T ObjectList)85 TTypes = class(TSourceNodes) 57 86 function SearchByName(Name: string): TType; 58 87 function AddNew(Name: string): TType; 59 88 end; 60 89 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 62 98 Name: string; 63 99 TypeRef: TType; … … 66 102 { TVariables } 67 103 68 TVariables = class(T ObjectList)104 TVariables = class(TSourceNodes) 69 105 function SearchByName(Name: string): TVariable; 70 106 end; 71 107 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 73 116 Name: string; 74 117 TypeRef: TType; … … 78 121 { TConstants } 79 122 80 TConstants = class(T ObjectList)123 TConstants = class(TSourceNodes) 81 124 function SearchByName(Name: string): TConstant; 82 125 function AddNew(Name: string): TConstant; 83 126 end; 84 127 85 TFunctionParameter = class 128 TFunctionParameter = class(TSourceNode) 86 129 Name: string; 87 130 TypeRef: TType; … … 90 133 { TFunctionParameters } 91 134 92 TFunctionParameters = class(T ObjectList)135 TFunctionParameters = class(TSourceNodes) 93 136 function SearchByName(Name: string): TFunctionParameter; 94 137 function AddNew(Name: string; TypeRef: TType): TFunctionParameter; … … 97 140 { TFunction } 98 141 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 100 148 Name: string; 101 149 InternalName: string; … … 109 157 { TFunctions } 110 158 111 TFunctions = class(T ObjectList)159 TFunctions = class(TSourceNodes) 112 160 function SearchByName(Name: string): TFunction; 113 161 function AddNew(Name: string): TFunction; 114 162 end; 115 163 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) 120 171 end; 121 172 … … 123 174 124 175 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 125 181 FunctionDef: TFunction; 126 182 Params: TExpressions; … … 132 188 133 189 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 134 195 Commands: TCommands; 135 196 procedure Clear; … … 143 204 { TExpression } 144 205 145 TExpression = class 206 TExpression = class(TSourceNode) 146 207 function GetType: TType; virtual; 147 208 end; … … 150 211 151 212 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 152 218 TypeRef: TType; 153 219 Operation: TExpressionOperator; … … 163 229 164 230 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 165 236 OperandType: TExpressionOperandType; 166 237 VariableRef: TVariable; … … 173 244 end; 174 245 175 TExpressions = class(T ObjectList)246 TExpressions = class(TSourceNodes) 176 247 end; 177 248 … … 179 250 180 251 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 181 257 Variable: TVariable; 182 258 Expression: TExpression; … … 188 264 189 265 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 190 271 Expression: TExpression; 191 272 CommandThen: TCommand; … … 198 279 199 280 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 200 286 Expression: TExpression; 201 287 Command: TCommand; … … 207 293 208 294 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 209 300 Expression: TExpression; 210 301 Commands: TCommands; … … 213 304 end; 214 305 306 TBreak = class(TCommand) 307 end; 308 309 TContinue = class(TCommand) 310 end; 311 215 312 { TForToDo } 216 313 217 314 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 218 320 VariableRef: TVariable; 219 321 ExpressionFrom: TExpression; … … 226 328 { TBlock } 227 329 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 229 336 Parent: TBlock; 230 337 Variables: TVariables; … … 244 351 { TProgram } 245 352 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 247 359 Name: string; 248 360 SystemBlock: TBlock; … … 253 365 end; 254 366 367 255 368 implementation 256 369 370 resourcestring 371 SIndexError = 'Index error'; 372 373 { TSourceNodes } 374 375 function TSourceNodes.GetCount: Integer; 376 begin 377 Result := List.Count; 378 end; 379 380 function TSourceNodes.GetItem(Index: Integer): TObject; 381 begin 382 Result := List[Index]; 383 end; 384 385 procedure TSourceNodes.SetItem(Index: Integer; AValue: TObject); 386 begin 387 List[Index] := AValue; 388 end; 389 390 procedure TSourceNodes.Clear; 391 begin 392 List.Clear; 393 end; 394 395 function TSourceNodes.Add(AObject: TObject): Integer; 396 begin 397 Result := List.Add(AObject); 398 end; 399 400 constructor TSourceNodes.Create; 401 begin 402 List := TObjectList.Create; 403 end; 404 405 destructor TSourceNodes.Destroy; 406 begin 407 List.Free; 408 inherited Destroy; 409 end; 410 411 { TVariable } 412 413 function TVariable.GetNode(Index: Integer): TSourceNode; 414 begin 415 if Index = 0 then Result := TypeRef 416 else raise Exception.Create(SIndexError); 417 end; 418 419 function TVariable.GetNodesCount: Integer; 420 begin 421 Result := 1; 422 end; 423 424 procedure TVariable.SetNode(Index: Integer; AValue: TSourceNode); 425 begin 426 if Index = 0 then TypeRef := TType(AValue) 427 else raise Exception.Create(SIndexError); 428 end; 429 430 { TConstant } 431 432 function TConstant.GetNode(Index: Integer): TSourceNode; 433 begin 434 if Index = 0 then Result := TypeRef 435 else raise Exception.Create(SIndexError); 436 end; 437 438 function TConstant.GetNodesCount: Integer; 439 begin 440 Result := 1; 441 end; 442 443 procedure TConstant.SetNode(Index: Integer; AValue: TSourceNode); 444 begin 445 if Index = 0 then TypeRef := TType(AValue) 446 else raise Exception.Create(SIndexError); 447 end; 448 449 { TSourceNode } 450 451 function TSourceNode.GetNode(Index: Integer): TSourceNode; 452 begin 453 raise Exception.Create(SIndexError); 454 end; 455 456 function TSourceNode.GetNodesCount: Integer; 457 begin 458 Result := 0; 459 end; 460 461 procedure TSourceNode.SetNode(Index: Integer; AValue: TSourceNode); 462 begin 463 raise Exception.Create(SIndexError); 464 end; 465 257 466 { TRepeatUntil } 467 468 function TRepeatUntil.GetNode(Index: Integer): TSourceNode; 469 begin 470 if Index = 0 then Result := Expression 471 else if Index = 1 then Result := Commands 472 else raise Exception.Create(SIndexError); 473 end; 474 475 function TRepeatUntil.GetNodesCount: Integer; 476 begin 477 Result := 2; 478 end; 479 480 procedure TRepeatUntil.SetNode(Index: Integer; AValue: TSourceNode); 481 begin 482 if Index = 0 then Expression := TExpression(AValue) 483 else if Index = 1 then Commands := TCommands(AValue) 484 else raise Exception.Create(SIndexError); 485 end; 258 486 259 487 constructor TRepeatUntil.Create; … … 303 531 { TForToDo } 304 532 533 function TForToDo.GetNode(Index: Integer): TSourceNode; 534 begin 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); 540 end; 541 542 function TForToDo.GetNodesCount: Integer; 543 begin 544 Result := 4; 545 end; 546 547 procedure TForToDo.SetNode(Index: Integer; AValue: TSourceNode); 548 begin 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); 554 end; 555 305 556 constructor TForToDo.Create; 306 557 begin 307 558 ExpressionFrom := TExpression.Create; 308 559 ExpressionTo := TExpression.Create; 309 Command := T Command.Create;560 Command := TEmptyCommand.Create; 310 561 end; 311 562 … … 326 577 327 578 { TExpressionOperand } 579 580 function TExpressionOperand.GetNode(Index: Integer): TSourceNode; 581 begin 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); 591 end; 592 593 function TExpressionOperand.GetNodesCount: Integer; 594 begin 595 Result := 1; 596 end; 597 598 procedure TExpressionOperand.SetNode(Index: Integer; AValue: TSourceNode); 599 begin 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); 609 end; 328 610 329 611 function TExpressionOperand.GetType: TType; … … 367 649 { TFunction } 368 650 651 function TFunction.GetNode(Index: Integer): TSourceNode; 652 begin 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); 657 end; 658 659 function TFunction.GetNodesCount: Integer; 660 begin 661 Result := 3; 662 end; 663 664 procedure TFunction.SetNode(Index: Integer; AValue: TSourceNode); 665 begin 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); 670 end; 671 369 672 constructor TFunction.Create; 370 673 begin … … 414 717 { TExpressionOperation } 415 718 719 function TExpressionOperation.GetNode(Index: Integer): TSourceNode; 720 begin 721 Result := TSourceNode(Items[Index]); 722 end; 723 724 function TExpressionOperation.GetNodesCount: Integer; 725 begin 726 Result := Items.Count; 727 end; 728 729 procedure TExpressionOperation.SetNode(Index: Integer; AValue: TSourceNode); 730 begin 731 Items[Index] := AValue; 732 end; 733 416 734 constructor TExpressionOperation.Create; 417 735 begin … … 431 749 432 750 { TAssignment } 751 752 function TAssignment.GetNode(Index: Integer): TSourceNode; 753 begin 754 if Index = 0 then Result := Expression 755 else if Index = 1 then Result := Variable 756 else raise Exception.Create(SIndexError); 757 end; 758 759 function TAssignment.GetNodesCount: Integer; 760 begin 761 Result := 2; 762 end; 763 764 procedure TAssignment.SetNode(Index: Integer; AValue: TSourceNode); 765 begin 766 if Index = 0 then Expression := TExpression(AValue) 767 else if Index = 1 then Variable := TVariable(AValue) 768 else raise Exception.Create(SIndexError); 769 end; 433 770 434 771 constructor TAssignment.Create; … … 447 784 { TIfThenElse } 448 785 786 function TIfThenElse.GetNode(Index: Integer): TSourceNode; 787 begin 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); 792 end; 793 794 function TIfThenElse.GetNodesCount: Integer; 795 begin 796 Result := 3; 797 end; 798 799 procedure TIfThenElse.SetNode(Index: Integer; AValue: TSourceNode); 800 begin 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); 805 end; 806 449 807 constructor TIfThenElse.Create; 450 808 begin 451 809 Expression := TExpression.Create; 452 CommandThen := T Command.Create;453 CommandElse := T Command.Create;810 CommandThen := TEmptyCommand.Create; 811 CommandElse := TEmptyCommand.Create; 454 812 end; 455 813 … … 464 822 { TWhileDo } 465 823 824 function TWhileDo.GetNode(Index: Integer): TSourceNode; 825 begin 826 Result:=inherited GetNode(Index); 827 end; 828 829 function TWhileDo.GetNodesCount: Integer; 830 begin 831 Result:=inherited GetNodesCount; 832 end; 833 834 procedure TWhileDo.SetNode(Index: Integer; AValue: TSourceNode); 835 begin 836 inherited SetNode(Index, AValue); 837 end; 838 466 839 constructor TWhileDo.Create; 467 840 begin 468 841 Expression := TExpression.Create; 469 Command := T Command.Create;842 Command := TEmptyCommand.Create; 470 843 end; 471 844 … … 478 851 479 852 { TFunctionCall } 853 854 function TFunctionCall.GetNode(Index: Integer): TSourceNode; 855 begin 856 if Index = 0 then Result := FunctionDef 857 else if Index = 1 then Result := Params 858 else raise Exception.Create(SIndexError); 859 end; 860 861 function TFunctionCall.GetNodesCount: Integer; 862 begin 863 Result := 2; 864 end; 865 866 procedure TFunctionCall.SetNode(Index: Integer; AValue: TSourceNode); 867 begin 868 if Index = 0 then FunctionDef := TFunction(AValue) 869 else if Index = 1 then Params := TExpressions(AValue) 870 else raise Exception.Create(SIndexError); 871 end; 480 872 481 873 constructor TFunctionCall.Create; … … 541 933 542 934 { TBlock } 935 936 function TBlock.GetNode(Index: Integer): TSourceNode; 937 begin 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); 944 end; 945 946 function TBlock.GetNodesCount: Integer; 947 begin 948 Result := 5; 949 end; 950 951 procedure TBlock.SetNode(Index: Integer; AValue: TSourceNode); 952 begin 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); 959 end; 543 960 544 961 procedure TBlock.Clear; … … 599 1016 { TBeginEnd } 600 1017 1018 function TBeginEnd.GetNode(Index: Integer): TSourceNode; 1019 begin 1020 if Index = 0 then Result := Commands 1021 else raise Exception.Create(SIndexError); 1022 end; 1023 1024 function TBeginEnd.GetNodesCount: Integer; 1025 begin 1026 Result := 1; 1027 end; 1028 1029 procedure TBeginEnd.SetNode(Index: Integer; AValue: TSourceNode); 1030 begin 1031 if Index = 0 then Commands := TCommands(AValue) 1032 else raise Exception.Create(SIndexError); 1033 end; 1034 601 1035 procedure TBeginEnd.Clear; 602 1036 begin … … 616 1050 617 1051 { TProgram } 1052 1053 function TProgram.GetNode(Index: Integer): TSourceNode; 1054 begin 1055 if Index = 0 then Result := Block 1056 else raise Exception.Create(SIndexError); 1057 end; 1058 1059 function TProgram.GetNodesCount: Integer; 1060 begin 1061 Result := 1; 1062 end; 1063 1064 procedure TProgram.SetNode(Index: Integer; AValue: TSourceNode); 1065 begin 1066 if Index = 0 then Block := TBlock(AValue) 1067 else raise Exception.Create(SIndexError); 1068 end; 618 1069 619 1070 procedure TProgram.Clear; -
branches/interpreter2/UTokenizer.pas
r205 r207 149 149 (Text = 'var') or (Text = 'const') or (Text = 'if') or (Text = 'then') or 150 150 (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'); 152 153 end; 153 154 -
branches/interpreter2/interpreter.lpi
r206 r207 72 72 </Item2> 73 73 </RequiredPackages> 74 <Units Count="1 3">74 <Units Count="14"> 75 75 <Unit0> 76 76 <Filename Value="interpreter.lpr"/> … … 124 124 <IsPartOfProject Value="True"/> 125 125 <ComponentName Value="FormMessages"/> 126 <HasResources Value="True"/> 126 127 <ResourceBaseClass Value="Form"/> 127 128 </Unit11> … … 130 131 <IsPartOfProject Value="True"/> 131 132 <ComponentName Value="FormSource"/> 133 <HasResources Value="True"/> 132 134 <ResourceBaseClass Value="Form"/> 133 135 </Unit12> 136 <Unit13> 137 <Filename Value="UOptimizer.pas"/> 138 <IsPartOfProject Value="True"/> 139 </Unit13> 134 140 </Units> 135 141 </ProjectOptions> -
branches/interpreter2/interpreter.lpr
r206 r207 10 10 Forms, UFormMain, UParser, UTokenizer, USource, UExecutor, UInterpreter, 11 11 UGeneratorPascal, UGeneratorPhp, UGenerator, UGeneratorCSharp, UFormMessages, 12 UFormSource 12 UFormSource, UOptimizer 13 13 { you can add units after this }; 14 14
Note:
See TracChangeset
for help on using the changeset viewer.