Changeset 6


Ignore:
Timestamp:
Oct 4, 2007, 5:13:15 PM (17 years ago)
Author:
george
Message:

Přidáno: Funkce pro pročištění stromu.

Files:
1 added
3 edited

Legend:

Unmodified
Added
Removed

  • PascalCompiler.dpr

    r3 r6  
    11program PascalCompiler;
    22
    3 {%File 'P0.grm'}
     3
    44
    55uses
    66  Forms,
    7   UMainForm in 'UMainForm.pas' {MainForm};
     7  UMainForm in 'UMainForm.pas' {MainForm},
     8  UGrammer in 'UGrammer.pas';
    89
    910{$R *.res}

  • UMainForm.dfm

    r3 r6  
    2424    Left = 8
    2525    Top = 8
    26     Width = 257
     26    Width = 290
    2727    Height = 313
     28    ScrollBars = ssBoth
    2829    TabOrder = 0
    2930  end
    3031  object Button1: TButton
    31     Left = 271
     32    Left = 304
    3233    Top = 8
    33     Width = 75
     34    Width = 50
    3435    Height = 25
    3536    Caption = 'Parse'

  • UMainForm.pas

    r5 r6  
    55uses
    66  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
    7   Dialogs, StdCtrls, ComCtrls;
     7  Dialogs, StdCtrls, ComCtrls, UGrammer;
    88
    99const
    … …  
    1111
    1212type
    13   TGrammerRule = class;
    14 
    15   TPathItem = record
    16   public
    17     Rule: TGrammerRule;
    18     ItemIndex: Integer;
    19     Affected: Boolean;
    20     CharIndex: Integer;
    21     procedure Assign(Source: TPathItem);
    22   end;
    23 
    24   TGrammerPath = record
    25     Items: array of TPathItem;
    26     procedure Assign(Source: TGrammerPath);
    27     procedure Next;
    28   end;
    29 
    30   TPossibleCharacter = record
    31     Character: Char;
    32     RulePath: TGrammerPath;
    33     procedure Assign(Source: TPossibleCharacter);
    34   end;
    35 
    36   TPossibleCharacters = record
    37     Items: array of TPossibleCharacter;
    38     procedure Assign(Source: TPossibleCharacters);
    39   end;
    40 
    41   TRuleType = (rtSequence, rtAlternative);
    42   TRuleItemType = (itTerminal, itNonterminal);
    43 
    44   TProgramItem = class
    45   public
    46     RuleBefore: TGrammerRule;
    47     Items: TList; // of TProgramItem;
    48     ItemType: TRuleItemType;
    49     Rule: TGrammerRule;
    50     Value: Char;
    51     constructor Create;
    52     destructor Destroy; override;
    53   end;
    54 
    55   TProgram = class
    56   public
    57     TopItem: TProgramItem;
    58     constructor Create;
    59     procedure Insert(Path: TGrammerPath; Character: Char);
    60     destructor Destroy; override;
    61   end;
    62 
    63   TGrammerItem = record
    64   private
    65     Parent: TGrammerRule;
    66     Processed: Boolean;
    67   public
    68     ItemType: TRuleItemType;
    69     Character: Char;
    70     Rule: TGrammerRule;
    71     Optional: Boolean;
    72     Repetition: Boolean;
    73     procedure GetPossibleCharacters(Path: TGrammerPath; var Characters: TPossibleCharacters);
    74     constructor Create(ItemType: TRuleType);
    75   end;
    76 
    77   TGrammerRule = class
    78   private
    79   public
    80     Name: string;
    81     RuleType: TRuleType;
    82     Items: array of TGrammerItem;
    83     procedure ClearProcessed;
    84     procedure AddTerminal(Character: Char; Optional, Repetition: Boolean);
    85     procedure AddTerminalText(Text: string);
    86     procedure AddRule(Rule: TGrammerRule; Optional, Repetition: Boolean);
    87     procedure ProcessCharacter(Character: Char);
    88     procedure GetPossibleCharacters(Path: TGrammerPath;
    89       var Characters: TPossibleCharacters; UseIndex: Integer = 0; UseCharIndex: Integer = -1);
    90     constructor Create;
    91   end;
    92 
    93   TGrammer = class
    94   public
    95     Rules: TList; // of TGrammerRule;
    96     TopRule: TGrammerRule;
    97     constructor Create;
    98     procedure ClearProcessed;
    99     procedure Parse(Text: string; var ParsedProgram: TProgram);
    100     destructor Destroy; override;
    101   end;
    102 
    10313  TMainForm = class(TForm)
    10414    Memo1: TMemo;
    … …  
    13141  SourceProgram := TProgram.Create;
    13242  Grammer.Parse(Memo1.Text, SourceProgram);
     43  with SourceProgram.TopItem do begin
     44    MergeNonterminal(TGrammerRule(Grammer.Rules[7]));
     45    MergeNonterminal(TGrammerRule(Grammer.Rules[9]));
     46    DeleteNonterminal(TGrammerRule(Grammer.Rules[0]));
     47    DeleteEmpty;
     48  end;
    13349  ShowProgramTree(SourceProgram);
    13450end;
    … …  
    13854  LowerCaseAlphabeticCharacter, UpperCaseAlphabeticCharacter,
    13955  Digit, AlphabeticCharacter, Number, AlphaNumericCharacter,
    140     Identifier, Assignment, Expression, RuleString, Rule, RuleList,
     56    Identifier, Expression, RuleString, Rule, RuleList,
    14157    OptionBlock, RepetitionBlock, GroupingBlock,
    14258    Term, AllCharacters, WhiteSpace, Concatenation, ConcatenationBlock,
    143     Separation, SeparationBlock: TGrammerRule;
     59    Separation, SeparationBlock, Definition: TGrammerRule;
    14460  C: Char;
    14561  I: Integer;
    … …  
    357273    Rules.Add(RuleList);
    358274
    359     TopRule := RuleList;
     275    Definition := TGrammerRule.Create;
     276    with Definition do begin
     277      Name := 'Definition';
     278      RuleType := rtSequence;
     279      AddRule(RuleList, False, False);
     280      AddRule(WhiteSpace, True, True);
     281      AddTerminal('.', False, False);
     282    end;
     283    Rules.Add(Definition);
     284
     285    TopRule := Definition;
    360286  end;
    361287
    … …  
    364290  SourceProgram := TProgram.Create;
    365291  Memo1.Lines.LoadFromFile(DefaultGrammerFileName);
    366   SourceCode := '';;
     292  SourceCode := '';
    367293//  with Memo1.Lines do
    368294//  for I := 1 to Length(Text) do begin
    … …  
    374300end;
    375301
    376 { TGrammerRule }
    377 
    378 procedure TGrammerRule.AddRule(Rule: TGrammerRule; Optional,
    379   Repetition: Boolean);
    380 begin
    381   SetLength(Items, Length(Items) + 1);
    382   Items[High(Items)].ItemType := itNonterminal;
    383   Items[High(Items)].Rule := Rule;
    384   Items[High(Items)].Optional := Optional;
    385   Items[High(Items)].Repetition := Repetition;
    386   Items[High(Items)].Parent := Self;
    387 end;
    388 
    389 procedure TGrammerRule.AddTerminal(Character: Char; Optional, Repetition: Boolean);
    390 begin
    391   SetLength(Items, Length(Items) + 1);
    392   Items[High(Items)].ItemType := itTerminal;
    393   Items[High(Items)].Character := Character;
    394   Items[High(Items)].Optional := Optional;
    395   Items[High(Items)].Repetition := Repetition;
    396   Items[High(Items)].Parent := Self;
    397 end;
    398 
    399 procedure TGrammerRule.AddTerminalText(Text: string);
    400 var
    401   I: Integer;
    402 begin
    403   for I := 1 to Length(Text) do AddTerminal(Text[I], False, False);
    404 end;
    405 
    406 procedure TGrammerRule.ClearProcessed;
    407 var
    408   I: Integer;
    409 begin
    410   for I := 0 to High(Items) do with Items[I] do begin
    411     Processed := False;
    412   end;
    413 end;
    414 
    415 constructor TGrammerRule.Create;
    416 begin
    417 
    418 end;
    419 
    420 procedure TGrammerRule.GetPossibleCharacters(Path: TGrammerPath;
    421   var Characters: TPossibleCharacters; UseIndex: Integer = 0; UseCharIndex: Integer = -1);
    422 var
    423   I: Integer;
    424   NextItemIndex, NextCharIndex: Integer;
    425   NextRule: TGrammerRule;
    426   TempPath: TGrammerPath;
    427 begin
    428   SetLength(Path.Items, Length(Path.Items) + 1);
    429   with Path.Items[High(Path.Items)] do begin
    430     Rule := Self;
    431     ItemIndex := UseIndex;
    432     CharIndex := UseCharIndex;
    433     Affected := True;
    434   end;
    435 
    436   case RuleType of
    437     rtAlternative: begin
    438       if UseIndex > 0 then begin
    439         // Forward generation to upper item
    440         SetLength(Path.Items, Length(Path.Items) - 1);
    441         with Path.Items[High(Path.Items)] do begin
    442           NextItemIndex := ItemIndex;
    443           NextCharIndex := CharIndex;
    444           NextRule := Rule;
    445         end;
    446         SetLength(Path.Items, Length(Path.Items) - 1);
    447         NextRule.GetPossibleCharacters(Path, Characters, NextItemIndex + 1, NextCharIndex);
    448       end else begin
    449         // Generate alternatives
    450         for I := 0 to High(Items) do begin
    451           Path.Items[High(Path.Items)].ItemIndex := I;
    452           //Inc(Path.Items[High(Path.Items)].CharIndex);
    453           Items[I].GetPossibleCharacters(Path, Characters);
    454         end;
    455       end;
    456     end;
    457     rtSequence: begin
    458       TempPath.Assign(Path);
    459       if UseIndex >= Length(Items) then begin
    460         // Forward generation to upper item
    461         SetLength(Path.Items, Length(Path.Items) - 1);
    462         with Path.Items[High(Path.Items)] do begin
    463           NextItemIndex := ItemIndex;
    464           NextCharIndex := CharIndex;
    465           NextRule := Rule;
    466         end;
    467         SetLength(Path.Items, Length(Path.Items) - 1);
    468         NextRule.GetPossibleCharacters(Path, Characters, NextItemIndex + 1, NextCharIndex);
    469       end else begin
    470         Path.Items[High(Path.Items)].ItemIndex := UseIndex;
    471         Items[UseIndex].GetPossibleCharacters(Path, Characters);
    472       end;
    473       // Check repetition
    474       if (UseIndex > 0) and not Items[UseIndex - 1].Processed then
    475         if Items[UseIndex - 1].Repetition then begin
    476           TempPath.Items[High(TempPath.Items)].ItemIndex := UseIndex - 1;
    477           Items[UseIndex - 1].GetPossibleCharacters(TempPath, Characters);
    478         end;
    479     end;
    480   end;
    481 end;
    482 
    483 procedure TGrammerRule.ProcessCharacter(Character: Char);
    484 begin
    485 end;
    486 
    487302procedure TMainForm.FormDestroy(Sender: TObject);
    488303begin
    … …  
    497312  I, II: Integer;
    498313  NewTreeNode: TTreeNode;
    499   NewTreeNode2: TTreeNode;
    500314  Attributs: string;
    501315begin
    … …  
    520334            else Attributs := '<?>' + Attributs;
    521335        end;
    522         NewTreeNode2 := AddChild(NewTreeNode, Attributs);
     336        AddChild(NewTreeNode, Attributs);
    523337      end;
    524338    end;
    … …  
    541355      else TreeView1.Items.AddChild(TreeNode, 'x');
    542356  end else begin
    543     TreeNode := TreeView1.Items.AddChild(Node, SourceProgram.Value);
     357    TreeView1.Items.AddChild(Node, SourceProgram.Value);
    544358  end;
    545359end;
    … …  
    557371end;
    558372
    559 { TGrammer }
    560 
    561 procedure TGrammer.ClearProcessed;
    562 var
    563   I: Integer;
    564 begin
    565   for I := 0 to Rules.Count - 1 do with TGrammerRule(Rules[I]) do begin
    566     ClearProcessed;
    567   end;
    568 end;
    569 
    570 constructor TGrammer.Create;
    571 begin
    572   Rules := TList.Create;
    573 end;
    574 
    575 destructor TGrammer.Destroy;
    576 var
    577   I: Integer;
    578 begin
    579   for I := 0 to Rules.Count - 1 do TGrammerRule(Rules[I]).Free;
    580   Rules.Free;
    581   inherited;
    582 end;
    583 
    584 procedure TGrammer.Parse(Text: string; var ParsedProgram: TProgram);
    585 var
    586   Path: TGrammerPath;
    587   I, II: Integer;
    588   C: Integer;
    589   Scope: TPossibleCharacters;
    590   UseIndex: Integer;
    591   UseCharIndex: Integer;
    592   UseRule: TGrammerRule;
    593   ExpectedCharacters: string;
    594   Level: Integer;
    595 begin
    596   SetLength(Path.Items, Length(Path.Items) + 1);
    597   with Path.Items[High(Path.Items)] do begin
    598     Rule := TopRule;
    599     ItemIndex := 0;
    600     CharIndex := -1;
    601   end;
    602 
    603   for I := 1 to Length(Text) do begin
    604     if (Text[I] <> #13) and (Text[I] <> #10) then begin
    605       UseIndex := Path.Items[High(Path.Items)].ItemIndex;
    606       UseCharIndex := Path.Items[High(Path.Items)].CharIndex;
    607       UseRule := Path.Items[High(Path.Items)].Rule;
    608       SetLength(Path.Items, Length(Path.Items) - 1);
    609       SetLength(Scope.Items, 0);
    610       ClearProcessed;
    611       UseRule.GetPossibleCharacters(Path, Scope, UseIndex, UseCharIndex);
    612       C := Length(Scope.Items);
    613       Level := 0; //High(Integer);
    614       for II := High(Scope.Items) downto 0 do begin
    615         if (Scope.Items[II].Character = Text[I]) and (Level < Length(Scope.Items[II].RulePath.Items))
    616         then begin
    617           C := II;
    618           Level := Length(Scope.Items[II].RulePath.Items);
    619         end;
    620       end;
    621       if C < Length(Scope.Items) then begin
    622         Path.Assign(Scope.Items[C].RulePath);
    623         for II := 0 to Length(Path.Items) - 1 do with Path.Items[II] do begin
    624           if Affected then Inc(CharIndex);
    625         end;
    626         ParsedProgram.Insert(Path, Scope.Items[C].Character);
    627         for II := 0 to Length(Path.Items) - 1 do with Path.Items[II] do begin
    628           Affected := False;
    629         end;
    630         //Path.Next;
    631       end else begin
    632         ExpectedCharacters := '';
    633         for II := 0 to Length(Scope.Items) - 1 do
    634           ExpectedCharacters := ExpectedCharacters + Scope.Items[II].Character;
    635         //raise Exception.Create('Parse error. Expected "' + ExpectedCharacters + '" but found "' + Text[I] + '".');
    636         break;
    637       end;
    638     end;
    639   end;
    640 
    641 end;
    642 
    643 { TProgram }
    644 
    645 constructor TProgram.Create;
    646 begin
    647   TopItem := TProgramItem.Create;
    648 end;
    649 
    650 destructor TProgram.Destroy;
    651 begin
    652   TopItem.Free;
    653   inherited;
    654 end;
    655 
    656 procedure TProgram.Insert(Path: TGrammerPath; Character: Char);
    657 var
    658   I: Integer;
    659   SelectedProgramItem: TProgramItem;
    660 begin
    661   SelectedProgramItem := TopItem;
    662   for I := 0 to High(Path.Items) do with Path.Items[I] do begin
    663     SelectedProgramItem.ItemType := itNonterminal;
    664     if not Assigned(SelectedProgramItem.Rule) then SelectedProgramItem.Rule := Rule;
    665     if SelectedProgramItem.Rule = Rule then begin
    666 //      if (Rule.RuleType = rtSequence) or (SelectedProgramItem.Rule = SelectedProgramItem.RuleBefore) then begin
    667         if SelectedProgramItem.Items.Count < (CharIndex + 1) then
    668           SelectedProgramItem.Items.Count := CharIndex + 1;
    669         if not Assigned(SelectedProgramItem.Items[CharIndex]) then
    670           SelectedProgramItem.Items[CharIndex] := TProgramItem.Create;
    671         SelectedProgramItem := TProgramItem(SelectedProgramItem.Items[CharIndex]);
    672 (*      end else begin
    673         SelectedProgramItem.Items.Count := SelectedProgramItem.Items.Count + 1;
    674         if not Assigned(SelectedProgramItem.Items[SelectedProgramItem.Items.Count - 1]) then
    675           SelectedProgramItem.Items[SelectedProgramItem.Items.Count - 1] := TProgramItem.Create;
    676         SelectedProgramItem := TProgramItem(SelectedProgramItem.Items[SelectedProgramItem.Items.Count - 1]);
    677       end;
    678 *)
    679     end;
    680   end;
    681   with SelectedProgramItem do begin
    682     ItemType := itTerminal;
    683     Value := Character;
    684   end;
    685 end;
    686 
    687 { TProgramItem }
    688 
    689 constructor TProgramItem.Create;
    690 begin
    691   Items := TList.Create;
    692 end;
    693 
    694 destructor TProgramItem.Destroy;
    695 var
    696   I: Integer;
    697 begin
    698   for I := 0 to Items.Count - 1 do TProgramItem(Items[I]).Free;
    699   Items.Free;
    700   inherited;
    701 end;
    702 
    703 { TGrammerItem }
    704 
    705 constructor TGrammerItem.Create(ItemType: TRuleType);
    706 begin
    707   Rule := nil;
    708 end;
    709 
    710 procedure TGrammerItem.GetPossibleCharacters(Path: TGrammerPath;
    711   var Characters: TPossibleCharacters);
    712 var
    713   Found: Boolean;
    714   PathIndex: Integer;
    715   NextItemIndex, NextCharIndex: Integer;
    716   NextRule: TGrammerRule;
    717 begin
    718   Processed := True;
    719   case ItemType of
    720     itTerminal: begin
    721       SetLength(Characters.Items, Length(Characters.Items) + 1);
    722       Characters.Items[High(Characters.Items)].Character := Character;
    723       Characters.Items[High(Characters.Items)].RulePath.Assign(Path);
    724       with Characters.Items[High(Characters.Items)].RulePath do begin
    725         Inc(Items[High(Items)].ItemIndex);
    726       end;
    727     end;
    728     itNonterminal: begin
    729       Rule.GetPossibleCharacters(Path, Characters);
    730     end;
    731   end;
    732   if Optional then begin
    733         // Forward generation to upper item
    734         //SetLength(Path.Items, Length(Path.Items) - 1);
    735         with Path.Items[High(Path.Items)] do begin
    736           NextItemIndex := ItemIndex;
    737           NextCharIndex := CharIndex;
    738           NextRule := Rule;
    739         end;
    740         SetLength(Path.Items, Length(Path.Items) - 1);
    741         NextRule.GetPossibleCharacters(Path, Characters, NextItemIndex + 1, NextCharIndex);
    742   end;
    743 end;
    744 
    745 { TGrammerPath }
    746 
    747 procedure TGrammerPath.Assign(Source: TGrammerPath);
    748 var
    749   I: Integer;
    750 begin
    751   SetLength(Items, Length(Source.Items));
    752   for I := 0 to High(Items) do Items[I].Assign(Source.Items[I]);
    753 end;
    754 
    755 procedure TGrammerPath.Next;
    756 var
    757   Index: Integer;
    758   Success: Boolean;
    759 begin
    760   Success := False;
    761   Index := High(Items);
    762   while not Success and (Index >= 0) do begin
    763     with Items[Index] do if Rule.Items[ItemIndex].Repetition then begin
    764       Success := True;
    765       //Inc(CharIndex);
    766     end else begin
    767       if ((ItemIndex + 1) < Length(Rule.Items)) and (Rule.RuleType = rtSequence) then begin
    768         Inc(ItemIndex);
    769         //Inc(CharIndex);
    770         Success := True;
    771       end else Dec(Index);
    772     end;
    773   end;
    774   SetLength(Items, Index + 1);
    775 end;
    776 
    777 { TPathItem }
    778 
    779 procedure TPathItem.Assign(Source: TPathItem);
    780 begin
    781   Rule := Source.Rule;
    782   ItemIndex := Source.ItemIndex;
    783   CharIndex := Source.CharIndex;
    784   Affected := Source.Affected;
    785 end;
    786 
    787 { TPossibleCharacter }
    788 
    789 procedure TPossibleCharacter.Assign(Source: TPossibleCharacter);
    790 begin
    791   Character := Source.Character;
    792   RulePath.Assign(Source.RulePath);
    793 end;
    794 
    795 { TPossibleCharacters }
    796 
    797 procedure TPossibleCharacters.Assign(Source: TPossibleCharacters);
    798 var
    799   I: Integer;
    800 begin
    801   SetLength(Items, Length(Source.Items));
    802   for I := 0 to High(Items) do Items[I].Assign(Source.Items[I]);
    803 end;
    804 
    805373end.
Note: See TracChangeset for help on using the changeset viewer.