Changeset 75 for trunk/Compiler/Modules/Pascal/SourceCodePascal.pas
- Timestamp:
- Jun 4, 2024, 12:22:49 AM (5 months ago)
- File:
-
- 1 moved
Legend:
- Unmodified
- Added
- Removed
-
trunk/Compiler/Modules/Pascal/SourceCodePascal.pas
r74 r75 1 unit USourceCodePascal; 2 3 {$MODE Delphi} 4 {$MACRO ON} 1 unit SourceCodePascal; 5 2 6 3 interface 7 4 8 5 uses 9 SysUtils, Variants, Classes, Dialogs, SpecializedList, USourceConvertor;6 SysUtils, Variants, Classes, Dialogs, Generics.Collections, SourceConvertor; 10 7 11 8 type … … 22 19 23 20 TCommonBlock = class; 24 TType List= class;25 TConstant List= class;26 TVariable List= class;27 TFunction List= class;28 T ListExpression= class;21 TTypes = class; 22 TConstants = class; 23 TVariables = class; 24 TFunctions = class; 25 TExpressions = class; 29 26 TExpression = class; 30 27 TFunction = class; … … 40 37 41 38 TContext = class 42 43 end; 44 45 TCommandList = class; 39 end; 40 41 TCommands = class; 46 42 47 43 TCommand = class … … 57 53 end; 58 54 59 // TListExpression = TGObjectList<Integer, TExpression> 60 TListExpression = class(TListObject); 55 { TExpressions } 56 57 TExpressions = class(TObjectList<TExpression>) 58 procedure Assign(Source: TExpressions); 59 end; 61 60 62 61 { TFunctionCall } … … 64 63 TFunctionCall = class(TCommand) 65 64 FunctionRef: TFunction; 66 ParameterExpression: T ListExpression;65 ParameterExpression: TExpressions; 67 66 constructor Create; 68 67 destructor Destroy; override; … … 70 69 71 70 TBeginEnd = class(TCommand) 72 Commands: TCommand List;71 Commands: TCommands; 73 72 CommonBlock: TCommonBlock; 74 73 procedure Clear; … … 90 89 91 90 TRepeatUntil = class(TCommand) 92 Block: TCommand List;91 Block: TCommands; 93 92 Condition: TExpression; 94 93 end; … … 120 119 end; 121 120 122 // TListCaseOfEndBranche = TGObjectList<Integer, TCaseOfEndBranche> 123 TListCaseOfEndBranche = class(TListObject); 121 TListCaseOfEndBranche = class(TObjectList<TCaseOfEndBranche>); 124 122 125 123 TCaseOfEnd = class(TCommand) … … 132 130 133 131 TTryFinally = class(TCommand) 134 Block: TCommand List;135 FinallyBlock: TCommand List;132 Block: TCommands; 133 FinallyBlock: TCommands; 136 134 end; 137 135 138 136 TTryExcept = class(TCommand) 139 Block: TCommandList; 140 ExceptBlock: TCommandList; 141 end; 142 143 // TCommandList = TGObjectList<Integer, TCommand> 144 TCommandList = class(TListObject); 137 Block: TCommands; 138 ExceptBlock: TCommands; 139 end; 140 141 TCommands = class(TObjectList<TCommand>); 145 142 146 143 TCommonBlockSection = (cbsVariable, cbsType, cbsConstant); … … 150 147 Parent: TCommonBlock; 151 148 ParentModule: TSourceModule; 152 Constants: TConstant List;153 Types: TType List;154 Variables: TVariable List;155 Functions: TFunction List;156 Order: T ListObject;149 Constants: TConstants; 150 Types: TTypes; 151 Variables: TVariables; 152 Functions: TFunctions; 153 Order: TObjectList<TObject>; 157 154 Code: TBeginEnd; 158 155 constructor Create; virtual; … … 166 163 ForwardDeclared: Boolean; 167 164 Internal: Boolean; 168 Parent: TType List;165 Parent: TTypes; 169 166 Name: string; 170 167 Size: Integer; … … 172 169 Exported: Boolean; 173 170 Visibility: TTypeVisibility; 174 Parameters: TType List;171 Parameters: TTypes; 175 172 procedure Assign(Source: TType); 176 173 constructor Create; … … 178 175 end; 179 176 180 // TListType = TGObjectList<Integer, TType> 181 TListType = class(TListObject); 182 183 TTypeList = class(TListType) 177 { TTypes } 178 179 TTypes = class(TObjectList<TType>) 184 180 Parent: TCommonBlock; 185 181 function Search(Name: string; Exported: Boolean = False): TType; 186 182 destructor Destroy; override; 183 function AddNew: TType; 187 184 end; 188 185 … … 214 211 end; 215 212 216 // TListEnumItem = TGObjectList<Integer, TEnumItem> 217 TListEnumItem = class(TListObject); 213 TEnumItems = class(TObjectList<TEnumItem>); 218 214 219 215 TTypeEnumeration = class(TType) 220 Items: T ListEnumItem;216 Items: TEnumItems; 221 217 constructor Create; 222 218 destructor Destroy; override; … … 239 235 end; 240 236 241 // TListConstant = TGObjectList<Integer, TConstant> 242 TListConstant = class(TListObject); 243 244 TConstantList = class(TListConstant) 237 TConstants = class(TObjectList<TConstant>) 245 238 Parent: TCommonBlock; 246 239 function Search(Name: string): TConstant; … … 256 249 end; 257 250 258 // TListVariable = TGObjectList<Integer, TVariable> 259 TListVariable = class(TListObject); 260 261 TVariableList = class(TListVariable) 251 TVariables = class(TObjectList<TVariable>) 262 252 Parent: TCommonBlock; 263 253 function Search(Name: string; Exported: Boolean = False): TVariable; … … 268 258 end; 269 259 270 // TListParameter = TGObjectList<Integer, TParameter> 271 TListParameter = class(TListObject); 272 273 TParameterList = class(TListParameter) 260 TParameters = class(TObjectList<TParameter>) 274 261 Parent: TFunction; 275 262 function Search(Name: string): TParameter; … … 288 275 Value: TValue; 289 276 OperatorName: string; 290 SubItems: T ListExpression;277 SubItems: TExpressions; 291 278 Associated: Boolean; 292 279 Braces: Boolean; … … 302 289 Internal: Boolean; 303 290 FunctionType: TFunctionType; 304 Parameters: TParameter List;291 Parameters: TParameters; 305 292 ResultType: TType; 306 293 Exported: Boolean; … … 310 297 end; 311 298 312 // TListFunction = TGObjectList<Integer, TFunction> 313 TListFunction = class(TListObject); 314 315 TFunctionList = class(TListFunction) 299 { TFunctions } 300 301 TFunctions = class(TObjectList<TFunction>) 316 302 Parent: TCommonBlock; 317 303 function Search(Name: string; Exported: Boolean = False): TFunction; 318 304 destructor Destroy; override; 305 function AddNew: TFunction; 319 306 end; 320 307 … … 326 313 end; 327 314 328 // TListUsedModule = TGObjectList<Integer, TUsedModule> 329 TListUsedModule = class(TListObject); 330 331 TUsedModuleList = class(TListUsedModule) 315 TUsedModules = class(TObjectList<TUsedModule>) 332 316 ParentModule: TSourceModule; 333 317 end; … … 340 324 Name: string; 341 325 TargetFile: string; 342 UsedModules: TUsedModule List;326 UsedModules: TUsedModules; 343 327 Body: TCommonBlock; 344 328 Internal: Boolean; … … 374 358 end; 375 359 376 // TListModule = TGObjectList<Integer, TModule> 377 TListModule = class(TListObject); 378 379 { TModuleList } 380 381 TModuleList = class(TListModule) 360 { TModules } 361 362 TModules = class(TObjectList<TSourceModule>) 382 363 function Search(Name: string): TSourceModule; 383 364 end; … … 387 368 TProgram = class(TSource) 388 369 Device: TDevice; 389 Modules: TModule List;370 Modules: TModules; 390 371 MainModule: TSourceModule; 391 372 procedure Clear; … … 408 389 SAssignmentError = 'Assignment error'; 409 390 391 410 392 implementation 411 393 … … 415 397 begin 416 398 inherited; 417 Parameters := TParameter List.Create;399 Parameters := TParameters.Create; 418 400 Parameters.Parent := Self; 419 401 //ResultType := TType.Create; … … 422 404 destructor TFunction.Destroy; 423 405 begin 424 Parameters.Free;425 // ResultType.Free;406 FreeAndNil(Parameters); 407 // FreeAndNil(ResultType); 426 408 inherited; 427 409 end; … … 438 420 begin 439 421 Device := TDevice.Create; 440 Modules := TModule List.Create;422 Modules := TModules.Create; 441 423 end; 442 424 443 425 destructor TProgram.Destroy; 444 426 begin 445 Modules.Free; 446 Device.Free; 447 end; 448 449 { TConstant } 450 451 452 { TConstantList } 453 454 destructor TConstantList.Destroy; 455 begin 456 inherited; 457 end; 458 459 function TConstantList.Search(Name: string): TConstant; 427 FreeAndNil(Modules); 428 FreeAndNil(Device); 429 end; 430 431 { TConstants } 432 433 destructor TConstants.Destroy; 434 begin 435 inherited; 436 end; 437 438 function TConstants.Search(Name: string): TConstant; 460 439 var 461 440 I: Integer; … … 476 455 begin 477 456 inherited; 478 UsedModules := TUsedModule List.Create;457 UsedModules := TUsedModules.Create; 479 458 UsedModules.ParentModule := Self; 480 459 Body := TCommonBlock.Create; … … 484 463 destructor TSourceModule.Destroy; 485 464 begin 486 Body.Free;487 UsedModules.Free;465 FreeAndNil(Body); 466 FreeAndNil(UsedModules); 488 467 inherited; 489 468 end; … … 504 483 constructor TCommonBlock.Create; 505 484 begin 506 Constants := TConstant List.Create;485 Constants := TConstants.Create; 507 486 Constants.Parent := Self; 508 Types := TType List.Create;487 Types := TTypes.Create; 509 488 Types.Parent := Self; 510 Variables := TVariable List.Create;489 Variables := TVariables.Create; 511 490 Variables.Parent := Self; 512 Functions := TFunction List.Create;491 Functions := TFunctions.Create; 513 492 Functions.Parent := Self; 514 493 Code := TBeginEnd.Create; 515 494 Code.Parent := Self; 516 495 Code.CommonBlock := Self; 517 Order := T ListObject.Create;496 Order := TObjectList<TObject>.Create; 518 497 Order.OwnsObjects := False; 519 498 end; … … 521 500 destructor TCommonBlock.Destroy; 522 501 begin 523 Constants.Free; 524 Types.Free; 525 Variables.Free; 526 Functions.Free; 527 Code.Free; 528 Order.Free; 529 inherited; 530 end; 531 532 { TTypeList } 533 534 destructor TTypeList.Destroy; 535 begin 536 inherited; 537 end; 538 539 function TTypeList.Search(Name: string; Exported: Boolean = False): TType; 502 FreeAndNil(Constants); 503 FreeAndNil(Types); 504 FreeAndNil(Variables); 505 FreeAndNil(Functions); 506 FreeAndNil(Code); 507 FreeAndNil(Order); 508 inherited; 509 end; 510 511 { TTypes } 512 513 destructor TTypes.Destroy; 514 begin 515 inherited; 516 end; 517 518 function TTypes.AddNew: TType; 519 begin 520 Result := TType.Create; 521 Add(Result); 522 end; 523 524 function TTypes.Search(Name: string; Exported: Boolean = False): TType; 540 525 var 541 526 I: Integer; … … 557 542 end; 558 543 559 { TVariable List}560 561 destructor TVariable List.Destroy;562 begin 563 inherited; 564 end; 565 566 function TVariable List.Search(Name: string; Exported: Boolean = False): TVariable;544 { TVariables } 545 546 destructor TVariables.Destroy; 547 begin 548 inherited; 549 end; 550 551 function TVariables.Search(Name: string; Exported: Boolean = False): TVariable; 567 552 var 568 553 I: Integer; … … 602 587 end; 603 588 604 { TFunctionList } 605 606 destructor TFunctionList.Destroy; 607 begin 608 inherited; 609 end; 610 611 function TFunctionList.Search(Name: string; Exported: Boolean): TFunction; 589 { TFunctions } 590 591 destructor TFunctions.Destroy; 592 begin 593 inherited; 594 end; 595 596 function TFunctions.AddNew: TFunction; 597 begin 598 Result := TFunction.Create; 599 Add(Result); 600 end; 601 602 function TFunctions.Search(Name: string; Exported: Boolean): TFunction; 612 603 var 613 604 I: Integer; … … 631 622 constructor TExpression.Create; 632 623 begin 633 SubItems := T ListExpression.Create;624 SubItems := TExpressions.Create; 634 625 SubItems.Count := 2; 635 626 SubItems.OwnsObjects := False; … … 638 629 destructor TExpression.Destroy; 639 630 begin 640 SubItems.Free;631 FreeAndNil(SubItems); 641 632 inherited; 642 633 end; … … 654 645 end; 655 646 656 { TParameter List}657 658 destructor TParameter List.Destroy;659 begin 660 inherited; 661 end; 662 663 function TParameter List.Search(Name: string): TParameter;647 { TParameters } 648 649 destructor TParameters.Destroy; 650 begin 651 inherited; 652 end; 653 654 function TParameters.Search(Name: string): TParameter; 664 655 var 665 656 I: Integer; … … 675 666 procedure TBeginEnd.Clear; 676 667 begin 677 678 668 end; 679 669 … … 681 671 begin 682 672 inherited; 683 Commands := TCommand List.Create;673 Commands := TCommands.Create; 684 674 end; 685 675 686 676 destructor TBeginEnd.Destroy; 687 677 begin 688 Commands.Free;678 FreeAndNil(Commands); 689 679 inherited; 690 680 end; … … 699 689 destructor TAssignment.Destroy; 700 690 begin 701 Source.Free; 702 inherited; 691 FreeAndNil(Source); 692 inherited; 693 end; 694 695 { TExpressions } 696 697 procedure TExpressions.Assign(Source: TExpressions); 698 var 699 I: Integer; 700 begin 701 while Count > Source.Count do Delete(Count - 1); 702 while Count < Source.Count do Add(TExpression.Create); 703 for I := 0 to Count - 1 do 704 Items[I].Assign(Source[I]); 703 705 end; 704 706 … … 713 715 destructor TWhileDo.Destroy; 714 716 begin 715 Condition.Free;716 Command.Free;717 FreeAndNil(Condition); 718 FreeAndNil(Command); 717 719 inherited; 718 720 end; … … 728 730 destructor TCaseOfEnd.Destroy; 729 731 begin 730 Branches.Free;732 FreeAndNil(Branches); 731 733 inherited; 732 734 end; … … 741 743 destructor TIfThenElse.Destroy; 742 744 begin 743 Condition.Free;744 inherited Destroy;745 FreeAndNil(Condition); 746 inherited; 745 747 end; 746 748 … … 750 752 begin 751 753 inherited; 752 ParameterExpression := T ListExpression.Create;754 ParameterExpression := TExpressions.Create; 753 755 end; 754 756 755 757 destructor TFunctionCall.Destroy; 756 758 begin 757 ParameterExpression.Free;758 inherited Destroy;759 FreeAndNil(ParameterExpression); 760 inherited; 759 761 end; 760 762 … … 770 772 destructor TForToDo.Destroy; 771 773 begin 772 Start.Free;773 Stop.Free;;774 inherited Destroy;774 FreeAndNil(Start); 775 FreeAndNil(Stop); 776 inherited; 775 777 end; 776 778 … … 785 787 destructor TTypeRecord.Destroy; 786 788 begin 787 CommonBlock.Free;788 inherited Destroy;789 end; 790 791 { TModule List}792 793 function TModule List.Search(Name: string): TSourceModule;789 FreeAndNil(CommonBlock); 790 inherited; 791 end; 792 793 { TModules } 794 795 function TModules.Search(Name: string): TSourceModule; 794 796 var 795 797 I: Integer; … … 820 822 function TSourceModule.SearchConstant(Name: string; Outside: Boolean): TConstant; 821 823 begin 822 823 824 end; 824 825 … … 864 865 destructor TModuleProgram.Destroy; 865 866 begin 866 inherited Destroy;867 inherited; 867 868 end; 868 869 … … 881 882 destructor TModuleUnit.Destroy; 882 883 begin 883 InititializeSection.Free;884 F inalalizeSection.Free;885 inherited Destroy;884 FreeAndNil(InititializeSection); 885 FreeAndNil(FinalalizeSection); 886 inherited; 886 887 end; 887 888 … … 891 892 begin 892 893 inherited; 893 Items := T ListEnumItem.Create;894 Items := TEnumItems.Create; 894 895 end; 895 896 896 897 destructor TTypeEnumeration.Destroy; 897 898 begin 898 Items.Free;899 inherited Destroy;899 FreeAndNil(Items); 900 inherited; 900 901 end; 901 902 … … 910 911 destructor TTypeClass.Destroy; 911 912 begin 912 CommonBlock.Free;913 inherited Destroy;913 FreeAndNil(CommonBlock); 914 inherited; 914 915 end; 915 916 … … 942 943 constructor TType.Create; 943 944 begin 944 Parameters := TType List.Create;945 Parameters := TTypes.Create; 945 946 //Parameters.Parent := Parent.Parent; 946 947 end; … … 948 949 destructor TType.Destroy; 949 950 begin 950 Parameters.Free;951 inherited Destroy;951 FreeAndNil(Parameters); 952 inherited; 952 953 end; 953 954
Note:
See TracChangeset
for help on using the changeset viewer.