Changeset 40 for branches/DelphiToC/Analyze/UPascalParser.pas
- Timestamp:
- Aug 5, 2010, 11:32:36 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/DelphiToC/Analyze/UPascalParser.pas
r39 r40 14 14 TOnErrorMessage = procedure (Text: string) of object; 15 15 16 TParserWhileDo = class(TWhileDo) 17 procedure Parse(Parser: TPascalParser); 18 end; 19 20 TParserExpression = class(TExpression) 21 function Parse(Parser: TPascalParser): TExpression; 22 end; 23 24 TParserModule = class(TModule) 25 procedure Parse(Parser: TPascalParser); 26 procedure ParseUnit(Parser: TPascalParser); 27 procedure ParseProgram(Parser: TPascalParser); 28 end; 29 30 TParserProgram = class(TProgram) 31 procedure Parse(Parser: TPascalParser); 32 end; 33 34 TParserCommonBlock = class(TCommonBlock) 35 procedure Parse(Parser: TPascalParser; EndSymbol: Char = ';'); 36 function ParseCommand(Parser: TPascalParser): TCommand; 37 end; 38 39 TParserBeginEnd = class(TBeginEnd) 40 procedure Parse(Parser: TPascalParser); 41 end; 42 43 TParserFunctionList = class(TFunctionList) 44 procedure Parse(Parser: TPascalParser); 45 end; 46 47 TParserIfThenElse = class(TIfThenElse) 48 procedure Parse(Parser: TPascalParser); 49 end; 50 51 TParserVariableList = class(TVariableList) 52 procedure Parse(Parser: TPascalParser); 53 end; 54 55 TParserVariable = class(TVariable) 56 procedure Parse(Parser: TPascalParser); 57 end; 58 59 TParserConstantList = class(TConstantList) 60 procedure Parse(Parser: TPascalParser); 61 end; 62 63 TParserTypeList = class(TTypeList) 64 procedure Parse(Parser: TPascalParser); 65 end; 66 67 TParserType = class(TType) 68 procedure Parse(Parser: TPascalParser); 16 { TParserWhileDo } 17 18 TParserWhileDo = class 19 class procedure Parse(Parser: TPascalParser; SourceCode: TWhileDo); 20 end; 21 22 { TParserExpression } 23 24 TParserExpression = class 25 class function Parse(Parser: TPascalParser; SourceCode: TExpression): TExpression; 26 end; 27 28 { TParserModule } 29 30 TParserModule = class 31 class procedure Parse(Parser: TPascalParser; SourceCode: TModule); 32 class procedure ParseUnit(Parser: TPascalParser; SourceCode: TModule); 33 class procedure ParseProgram(Parser: TPascalParser; SourceCode: TModule); 34 end; 35 36 TParserProgram = class 37 class procedure Parse(Parser: TPascalParser; SourceCode: TProgram); 38 end; 39 40 { TParserCommonBlock } 41 42 TParserCommonBlock = class 43 class procedure Parse(Parser: TPascalParser; SourceCode: TCommonBlock; EndSymbol: Char = ';'); 44 class function ParseCommand(Parser: TPascalParser; SourceCode: TCommonBlock): TCommand; 45 end; 46 47 { TParserBeginEnd } 48 49 TParserBeginEnd = class 50 class procedure Parse(Parser: TPascalParser; SourceCode: TBeginEnd); 51 end; 52 53 TParserFunctionList = class 54 class procedure Parse(Parser: TPascalParser; SourceCode: TFunctionList); 55 end; 56 57 TParserIfThenElse = class 58 class procedure Parse(Parser: TPascalParser; SourceCode: TIfThenElse); 59 end; 60 61 TParserVariableList = class 62 class procedure Parse(Parser: TPascalParser; SourceCode: TVariableList); 63 end; 64 65 TParserVariable = class 66 class procedure Parse(Parser: TPascalParser; SourceCode: TVariable); 67 end; 68 69 TParserConstantList = class 70 class procedure Parse(Parser: TPascalParser; SourceCode: TConstantList); 71 end; 72 73 TParserTypeList = class 74 class procedure Parse(Parser: TPascalParser; SourceCode: TTypeList); 75 end; 76 77 TParserType = class 78 class procedure Parse(Parser: TPascalParser; SourceCode: TType); 69 79 end; 70 80 … … 76 86 public 77 87 CodePosition: Integer; 78 SourceCode : TStringList;88 SourceCodeText: TStringList; 79 89 function IsAlphanumeric(Character: Char): Boolean; 80 90 function NextCode(Shift: Boolean = False): string; … … 197 207 J := CodePosition; 198 208 I := CodePosition; 199 with SourceCode do209 with SourceCodeText do 200 210 while Result = '' do begin 201 211 while IsWhiteSpace(Text[I]) do Inc(I); … … 250 260 { TParserWhileDo } 251 261 252 procedure TParserWhileDo.Parse(Parser: TPascalParser);253 begin 254 with Parser do begin262 class procedure TParserWhileDo.Parse(Parser: TPascalParser; SourceCode: TWhileDo); 263 begin 264 with Parser, SourceCode do begin 255 265 Expect('while'); 256 266 Condition.CommonBlock := CommonBlock; 257 TParserExpression (Condition).Parse(Parser);267 TParserExpression.Parse(Parser, Condition); 258 268 Expect('do'); 259 Command := TParserCommonBlock (CommonBlock).ParseCommand(Parser);269 Command := TParserCommonBlock.ParseCommand(Parser, CommonBlock); 260 270 end; 261 271 end; … … 263 273 { TExpression } 264 274 265 function TParserExpression.Parse(Parser: TPascalParser): TExpression; 275 class function TParserExpression.Parse(Parser: TPascalParser; 276 SourceCode: TExpression): TExpression; 266 277 var 267 278 Identifier: string; … … 277 288 Expressions := TExpressionList.Create; 278 289 Expressions.Add(TExpression.Create); 279 with Parser do begin290 with Parser, SourceCode do begin 280 291 while ((NextCode <> ';') and (NextCode <> ',') and (not IsKeyWord(NextCode))) and 281 292 not (((NextCode = ')') or (NextCode = ']'))) do begin … … 285 296 with TExpression(Expressions.Last) do begin 286 297 SubItems[1] := TExpression.Create; 287 TParserExpression (SubItems[1]).Parse(Parser);298 TParserExpression.Parse(Parser, TExpression(SubItems[1])); 288 299 end; 289 300 with TExpression(Expressions.Items[Expressions.Add(TExpression.Create)]) do begin 290 CommonBlock := S elf.CommonBlock;301 CommonBlock := SourceCode.CommonBlock; 291 302 SubItems[0] := TExpression(Expressions[Expressions.Count - 2]).SubItems[1]; 292 303 end; … … 309 320 end; 310 321 with TExpression(Expressions.Items[Expressions.Add(TExpression.Create)]) do begin 311 CommonBlock := S elf.CommonBlock;322 CommonBlock := SourceCode.CommonBlock; 312 323 SubItems[0] := TExpression(Expressions[Expressions.Count - 2]).SubItems[1]; 313 324 end; … … 323 334 NewExpression := TExpression.Create; 324 335 NewExpression.CommonBlock := CommonBlock; 325 TParserExpression (NewExpression).Parse(Parser);336 TParserExpression.Parse(Parser, NewExpression); 326 337 SubItems.Add(NewExpression); 327 338 while NextCode = ',' do begin … … 329 340 NewExpression := TExpression.Create; 330 341 NewExpression.CommonBlock := CommonBlock; 331 TParserExpression (NewExpression).Parse(Parser);342 TParserExpression.Parse(Parser, NewExpression); 332 343 SubItems.Add(NewExpression); 333 344 end; … … 338 349 end; 339 350 with TExpression(Expressions.Items[Expressions.Add(TExpression.Create)]) do begin 340 CommonBlock := S elf.CommonBlock;351 CommonBlock := SourceCode.CommonBlock; 341 352 SubItems[0] := TExpression(Expressions[Expressions.Count - 2]).SubItems[1]; 342 353 end; … … 351 362 end; 352 363 with TExpression(Expressions.Items[Expressions.Add(TExpression.Create)]) do begin 353 CommonBlock := S elf.CommonBlock;364 CommonBlock := SourceCode.CommonBlock; 354 365 SubItems[0] := TExpression(Expressions[Expressions.Count - 2]).SubItems[1]; 355 366 end; … … 364 375 with TExpression(Expressions.Last) do begin 365 376 SubItems[1] := TExpression.Create; 366 TExpression(SubItems[1]).CommonBlock := S elf.CommonBlock;377 TExpression(SubItems[1]).CommonBlock := SourceCode.CommonBlock; 367 378 TExpression(SubItems[1]).NodeType := ntConstant; 368 379 … … 378 389 //ShowMessage(IntToStr(Expressions.Count)); 379 390 with TExpression(Expressions.Items[Expressions.Add(TExpression.Create)]) do begin 380 CommonBlock := S elf.CommonBlock;391 CommonBlock := SourceCode.CommonBlock; 381 392 SubItems[0] := TExpression(Expressions[Expressions.Count - 2]).SubItems[1]; 382 393 end; … … 397 408 end; 398 409 end; 399 end;400 Assign(TExpression(TExpression(Expressions.First).SubItems[1]));401 TExpression(Expressions.First).SubItems[1] := nil;402 //ShowMessage(IntToStr(Expressions.Count));403 TExpression(Expressions[1]).SubItems[0] := nil;404 Expressions.Destroy;405 end; 406 407 function TParserCommonBlock.ParseCommand(Parser: TPascalParser): TCommand;410 Assign(TExpression(TExpression(Expressions.First).SubItems[1])); 411 TExpression(Expressions.First).SubItems[1] := nil; 412 //ShowMessage(IntToStr(Expressions.Count)); 413 TExpression(Expressions[1]).SubItems[0] := nil; 414 Expressions.Destroy; 415 end; 416 end; 417 418 class function TParserCommonBlock.ParseCommand(Parser: TPascalParser; SourceCode: TCommonBlock): TCommand; 408 419 var 409 420 Identifier: string; … … 419 430 if NextCode = 'begin' then begin 420 431 Result := TBeginEnd.Create; 421 Result.CommonBlock := S elf;422 TParserBeginEnd (Result).Parse(Parser);432 Result.CommonBlock := SourceCode; 433 TParserBeginEnd.Parse(Parser, TBeginEnd(Result)); 423 434 end else 424 435 if NextCode = 'if' then begin 425 436 Result := TIfThenElse.Create; 426 Result.CommonBlock := S elf;427 TParserIfThenElse (Result).Parse(Parser);437 Result.CommonBlock := SourceCode; 438 TParserIfThenElse.Parse(Parser, TIfThenElse(Result)); 428 439 end else 429 440 if NextCode = 'while' then begin 430 441 Result := TWhileDo.Create; 431 Result.CommonBlock := S elf;432 TParserWhileDo (Result).Parse(Parser);442 Result.CommonBlock := SourceCode; 443 TParserWhileDo.Parse(Parser, TWhileDo(Result)); 433 444 end else 434 445 if IsIdentificator(NextCode) then begin 435 if Assigned( Variables.Search(NextCode)) then begin446 if Assigned(SourceCode.Variables.Search(NextCode)) then begin 436 447 Result := TAssignment.Create; 437 Result.CommonBlock := S elf;448 Result.CommonBlock := SourceCode; 438 449 IdentName := ReadCode; 439 TAssignment(Result).Target := Variables.Search(IdentName);450 TAssignment(Result).Target := SourceCode.Variables.Search(IdentName); 440 451 Expect(':='); 441 452 TAssignment(Result).Source := TExpression.Create; 442 TAssignment(Result).Source.CommonBlock := S elf;443 TParserExpression (TAssignment(Result).Source).Parse(Parser);453 TAssignment(Result).Source.CommonBlock := SourceCode; 454 TParserExpression.Parse(Parser, TAssignment(Result).Source); 444 455 end else 445 if Assigned( Methods.Search(NextCode)) then begin456 if Assigned(SourceCode.Methods.Search(NextCode)) then begin 446 457 Result := TMethodCall.Create; 447 Result.CommonBlock := S elf;458 Result.CommonBlock := SourceCode; 448 459 // ParseMetVariable(TMethodCall(Result).Target); 449 460 end; … … 577 588 { TParserModule } 578 589 579 procedure TParserModule.Parse(Parser: TPascalParser);590 class procedure TParserModule.Parse(Parser: TPascalParser; SourceCode: TModule); 580 591 begin 581 592 with Parser do begin 582 593 if NextCode = 'program' then 583 ParseProgram(Parser )594 ParseProgram(Parser, SourceCode) 584 595 else if NextCode = 'unit' then 585 ParseUnit(Parser )586 else ParseProgram(Parser );587 end; 588 end; 589 590 procedure TParserModule.ParseProgram(Parser: TPascalParser);596 ParseUnit(Parser, SourceCode) 597 else ParseProgram(Parser, SourceCode); 598 end; 599 end; 600 601 class procedure TParserModule.ParseProgram(Parser: TPascalParser; SourceCode: TModule); 591 602 var 592 603 Identifier: string; 593 604 begin 594 with Parser do begin605 with Parser, SourceCode do begin 595 606 if NextCode = 'program' then begin 596 607 Expect('program'); … … 608 619 end; 609 620 end; 610 TParserCommonBlock (Self).Parse(Parser, '.');611 end; 612 end; 613 614 procedure TParserModule.ParseUnit(Parser: TPascalParser);621 TParserCommonBlock.Parse(Parser, SourceCode, '.'); 622 end; 623 end; 624 625 class procedure TParserModule.ParseUnit(Parser: TPascalParser; SourceCode: TModule); 615 626 begin 616 627 with Parser do begin … … 628 639 { TParserProgram } 629 640 630 procedure TParserProgram.Parse(Parser: TPascalParser);641 class procedure TParserProgram.Parse(Parser: TPascalParser; SourceCode: TProgram); 631 642 var 632 643 I: Integer; 633 644 begin 634 with Parser do begin645 with Parser, SourceCode do begin 635 646 Log('==== Parse start ===='); 636 647 Modules.Clear; … … 652 663 end; 653 664 end; 654 TParserModule (TModule(Modules[0])).Parse(Parser);665 TParserModule.Parse(Parser, TModule(Modules[0])); 655 666 end; 656 667 end; … … 658 669 { TParserCommonBlock } 659 670 660 procedure TParserCommonBlock.Parse(Parser: TPascalParser; EndSymbol: Char = ';');661 begin 662 with Parser do begin671 class procedure TParserCommonBlock.Parse(Parser: TPascalParser; SourceCode: TCommonBlock; EndSymbol: Char = ';'); 672 begin 673 with Parser, SourceCode do begin 663 674 while NextCode <> EndSymbol do begin 664 675 if NextCode = 'var' then 665 TParserVariableList (Variables).Parse(Parser)676 TParserVariableList.Parse(Parser, Variables) 666 677 else if NextCode = 'const' then 667 TParserConstantList (Constants).Parse(Parser)678 TParserConstantList.Parse(Parser, Constants) 668 679 else if NextCode = 'type' then 669 TParserTypeList (Types).Parse(Parser)680 TParserTypeList.Parse(Parser, Types) 670 681 else if NextCode = 'procedure' then 671 TParserFunctionList (Methods).Parse(Parser)682 TParserFunctionList.Parse(Parser, Methods) 672 683 else begin 673 TParserBeginEnd (Code).Parse(Parser);684 TParserBeginEnd.Parse(Parser, Code); 674 685 Break; 675 686 end; … … 681 692 { TParserBeginEnd } 682 693 683 procedure TParserBeginEnd.Parse(Parser: TPascalParser);694 class procedure TParserBeginEnd.Parse(Parser: TPascalParser; SourceCode: TBeginEnd); 684 695 var 685 696 NewCommand: TCommand; 686 697 begin 687 with Parser do begin698 with Parser, SourceCode do begin 688 699 Expect('begin'); 689 700 while NextCode <> 'end' do begin 690 NewCommand := TParserCommonBlock (CommonBlock).ParseCommand(Parser);701 NewCommand := TParserCommonBlock.ParseCommand(Parser, CommonBlock); 691 702 if Assigned(NewCommand) then Commands.Add(NewCommand); 692 703 //ShowMessage(NextCode); … … 699 710 { TParserParseFunctionList } 700 711 701 procedure TParserFunctionList.Parse(Parser: TPascalParser);712 class procedure TParserFunctionList.Parse(Parser: TPascalParser; SourceCode: TFunctionList); 702 713 var 703 714 Identifiers: TStringList; … … 709 720 begin 710 721 Identifiers := TStringList.Create; 711 with Parser do begin722 with Parser, SourceCode do begin 712 723 with TFunction(Items[Add(TFunction.Create)]) do begin 713 Parent := S elf.Parent;724 Parent := SourceCode.Parent; 714 725 Expect('procedure'); 715 726 Name := ReadCode; … … 743 754 end; 744 755 Expect(';'); 745 TParserCommonBlock (TFunction(Items[Count - 1])).Parse(Parser);756 TParserCommonBlock.Parse(Parser, TFunction(Items[Count - 1])); 746 757 end; 747 758 Identifiers.Destroy; … … 750 761 { TParserIfThenElse } 751 762 752 procedure TParserIfThenElse.Parse(Parser: TPascalParser);763 class procedure TParserIfThenElse.Parse(Parser: TPascalParser; SourceCode: TIfThenElse); 753 764 begin 754 765 with Parser do begin … … 763 774 { TParserVariableList } 764 775 765 procedure TParserVariableList.Parse(Parser: TPascalParser);776 class procedure TParserVariableList.Parse(Parser: TPascalParser; SourceCode: TVariableList); 766 777 var 767 778 Identifiers: TStringList; … … 773 784 begin 774 785 Identifiers := TStringList.Create; 775 with Parser do begin786 with Parser, SourceCode do begin 776 787 Expect('var'); 777 788 while IsIdentificator(NextCode) do begin … … 802 813 { TParserVariable } 803 814 804 procedure TParserVariable.Parse(Parser: TPascalParser);805 begin 806 with Parser do begin815 class procedure TParserVariable.Parse(Parser: TPascalParser; SourceCode: TVariable); 816 begin 817 with Parser, SourceCode do begin 807 818 Name := NextCode; 808 819 Expect(':='); … … 813 824 { TParserConstantList } 814 825 815 procedure TParserConstantList.Parse(Parser: TPascalParser);826 class procedure TParserConstantList.Parse(Parser: TPascalParser; SourceCode: TConstantList); 816 827 var 817 828 Identifiers: TStringList; … … 824 835 begin 825 836 Identifiers := TStringList.Create; 826 with Parser do begin837 with Parser, SourceCode do begin 827 838 Expect('const'); 828 839 while IsIdentificator(NextCode) do begin … … 857 868 { TParserTypeList } 858 869 859 procedure TParserTypeList.Parse(Parser: TPascalParser);860 begin 861 with Parser do begin870 class procedure TParserTypeList.Parse(Parser: TPascalParser; SourceCode: TTypeList); 871 begin 872 with Parser, SourceCode do begin 862 873 Expect('type'); 863 874 while IsIdentificator(NextCode) do 864 875 with TType(Items[Add(TType.Create)]) do begin 865 Parent := S elf;866 TParserType (Items[Count - 1]).Parse(Parser);876 Parent := SourceCode; 877 TParserType.Parse(Parser, TType(Items[Count - 1])); 867 878 end; 868 879 end; … … 871 882 { TParserType } 872 883 873 procedure TParserType.Parse(Parser: TPascalParser);874 begin 875 with Parser do begin884 class procedure TParserType.Parse(Parser: TPascalParser; SourceCode: TType); 885 begin 886 with Parser, SourceCode do begin 876 887 Name := NextCode; 877 888 Expect('=');
Note:
See TracChangeset
for help on using the changeset viewer.