Changeset 7 for UMainForm.pas

Timestamp:

Oct 12, 2007, 1:43:10 PM (17 years ago)

Author:

george

Message:

Tvorba gramatiky pascalu

File:

• UMainForm.pas (modified) (6 diffs)

UMainForm.pas

@@ -16 +16 @@
     TreeView1: TTreeView;
     TreeView2: TTreeView;
+    Label1: TLabel;
+    Button2: TButton;
     procedure FormCreate(Sender: TObject);
     procedure FormDestroy(Sender: TObject);
     procedure Button1Click(Sender: TObject);
+    procedure Button2Click(Sender: TObject);
   private
     procedure ShowProgramNode(Node: TTreeNode; SourceProgram: TProgramItem);
@@ -24 +27 @@
   public
     Grammer: TGrammer;
+    PascalGrammer: TGrammer;
     SourceProgram: TProgram;
     procedure ShowProgramTree(SourceProgram: TProgram);
     procedure ShowGrammerTree(Grammer: TGrammer);
+    procedure ShowGrammerRule(TreeNode: TTreeNode; ARule: TGrammerRule;
+      Attributs: string = '');
+    procedure ProcessProgramTree;
+    function ProcessConcatenationItem(ARule: TGrammerRule; ProgramItem: TProgramItem): TGrammerItem;
+    function ProcessSeparationItem(var ARule: TGrammerRule; ProgramItem: TProgramItem): TGrammerItem;
   end;
 
@@ -46 +55 @@
     DeleteNonterminal(TGrammerRule(Grammer.Rules[0]));
     DeleteEmpty;
+    Join(TGrammerRule(Grammer.Rules[17]), 1);
+    Join(TGrammerRule(Grammer.Rules[15]), 0);
+    Join(TGrammerRule(Grammer.Rules[14]), 0);
   end;
   ShowProgramTree(SourceProgram);
+end;
+
+procedure TMainForm.Button2Click(Sender: TObject);
+begin
+  ProcessProgramTree;
+  PascalGrammer.CorrectRuleLinks;
+  ShowGrammerTree(PascalGrammer);
 end;
 
@@ -62 +81 @@
   SourceCode: string;
 begin
+  PascalGrammer := TGrammer.Create;
+
   Grammer := TGrammer.Create;
   with Grammer do begin
@@ -303 +324 @@
 begin
   Memo1.Lines.SaveToFile(DefaultGrammerFileName);
-
+  PascalGrammer.Free;
   Grammer.Free;
   SourceProgram.Free;
 end;
 
-procedure TMainForm.ShowGrammerTree(Grammer: TGrammer);
-var
-  I, II: Integer;
+function TMainForm.ProcessConcatenationItem(ARule: TGrammerRule; ProgramItem: TProgramItem): TGrammerItem;
+var
+  I: Integer;
+  II: Integer;
+  NewRule: TGrammerRule;
+  NewSubRule: TGrammerRule;
+  RuleItem: TGrammerItem;
+type
+  LowerChars = 'a'..'z';
+begin
+  with ProgramItem do begin
+    ARule.RuleType := rtSequence;
+    for II := 0 to Items.Count - 1 do begin
+      RuleItem := ARule.Add;
+      if TProgramItem(Items[II]).Rule.Name = 'Term' then begin
+        RuleItem.ItemType := itNonterminal;
+        with TProgramItem(TProgramItem(Items[II]).Items[0]) do
+          if (Value[1] >= 'a') and (Value[1] <= 'z') then begin
+            RuleItem.ItemType := itNonterminal;
+            RuleItem.RuleName := Value;
+            RuleItem.Rule := nil;
+          end else begin
+            NewRule := TGrammerRule.Create;
+            NewRule.Ownership := ARule;
+            NewRule.Name := 'Term';
+            NewRule.AddTerminalText(Value);
+            PascalGrammer.Rules.Add(NewRule);
+            RuleItem.Rule := NewRule;
+            RuleItem.ItemType := itNonterminal;
+          end;
+      end else if TProgramItem(Items[II]).Rule.Name = 'GroupingBlock' then begin
+        NewRule := TGrammerRule.Create;
+        NewRule.Ownership := ARule;
+        NewRule.RuleType := rtSequence;
+        NewRule.Name := 'Group';
+        ProcessSeparationItem(NewRule, TProgramItem(Items[II]).Items[1]);
+        PascalGrammer.Rules.Add(NewRule);
+        RuleItem.ItemType := itNonterminal;
+        RuleItem.Rule := NewRule;
+      end else if TProgramItem(Items[II]).Rule.Name = 'OptionBlock' then begin
+        NewRule := TGrammerRule.Create;
+        NewRule.Ownership := ARule;
+        NewRule.RuleType := rtSequence;
+        NewRule.Name := 'Option';
+        ProcessSeparationItem(NewRule, TProgramItem(Items[II]).Items[1]);
+        PascalGrammer.Rules.Add(NewRule);
+        RuleItem.ItemType := itNonterminal;
+        RuleItem.Optional := True;
+        RuleItem.Rule := NewRule;
+      end else if TProgramItem(Items[II]).Rule.Name = 'RepetitionBlock' then begin
+        NewRule := TGrammerRule.Create;
+        NewRule.Ownership := ARule;
+        NewRule.RuleType := rtSequence;
+        NewRule.Name := 'Repetition';
+        ProcessSeparationItem(NewRule, TProgramItem(Items[II]).Items[1]);
+        PascalGrammer.Rules.Add(NewRule);
+        RuleItem.Repetition := True;
+        RuleItem.ItemType := itNonterminal;
+        RuleItem.Rule := NewRule;
+      end;
+    end;
+  end;
+end;
+
+procedure TMainForm.ProcessProgramTree;
+var
+  I: Integer;
+  NewRule: TGrammerRule;
+begin
+  for I := 0 to PascalGrammer.Rules.Count - 1 do
+    TGrammerRule(PascalGrammer.Rules[I]).Free;
+  PascalGrammer.Rules.Clear;
+  PascalGrammer.TopRule := nil;
+  with SourceProgram.TopItem do begin
+    with TProgramItem(Items[0]) do begin
+      for I := 0 to Items.Count - 1 do with TProgramItem(Items[I]) do begin
+        NewRule := TGrammerRule.Create;
+        with PascalGrammer do
+          if TopRule = nil then TopRule := NewRule;
+        NewRule.Name := TProgramItem(Items[0]).Value;
+        ProcessSeparationItem(NewRule, TProgramItem(Items[2]));
+        PascalGrammer.Rules.Add(NewRule);
+      end;
+    end;
+  end;
+end;
+
+function TMainForm.ProcessSeparationItem(var ARule: TGrammerRule;
+  ProgramItem: TProgramItem): TGrammerItem;
+var
+  II: Integer;
+  NewSubRule: TGrammerRule;
+  RuleItem: TGrammerItem;
+begin
+  with ProgramItem do
+    if Items.Count > 1 then begin
+      ARule.RuleType := rtAlternative;
+      for II := 0 to Items.Count - 1 do begin
+        NewSubRule := TGrammerRule.Create;
+        NewSubRule.Ownership := ARule;
+        NewSubRule.Name := ARule.Name;
+        RuleItem := ARule.Add;
+        RuleItem.ItemType := itNonterminal;
+        RuleItem.Rule := NewSubRule;
+        ProcessConcatenationItem(NewSubRule, TProgramItem(Items[II]));
+        PascalGrammer.Rules.Add(NewSubRule);
+      end;
+    end else begin
+      ProcessConcatenationItem(ARule, TProgramItem(Items[0]));
+    end;
+end;
+
+procedure TMainForm.ShowGrammerRule(TreeNode: TTreeNode; ARule: TGrammerRule;
+  Attributs: string = '');
+var
+  II: Integer;
   NewTreeNode: TTreeNode;
-  Attributs: string;
-begin
-  with Grammer, TreeView2, Items do begin
-    BeginUpdate;
-    Clear;
-    TopItem := AddChild(nil, 'Gramatika');
-    for I := 0 to Rules.Count - 1 do with TGrammerRule(Rules[I]) do begin
+//  NewNode: TTreeNode;
+begin
+  with TreeView2, Items, ARule do begin
       case RuleType of
-        rtSequence: Attributs := '(Seq)';
-        rtAlternative: Attributs := '(Alt)';
+        rtSequence: Attributs := Attributs + '(Seq)';
+        rtAlternative: Attributs := Attributs + '(Alt)';
       end;
-      NewTreeNode := AddChild(TopItem, Name + Attributs);
+      NewTreeNode := AddChild(TreeNode, ARule.Name + Attributs);
       for II := 0 to Length(Items) - 1 do
       with Items[II] do begin
@@ -329 +459 @@
         if Repetition then Attributs := Attributs + '(Rep)';
         case ItemType of
-          itTerminal: Attributs := Character + Attributs;
-          itNonterminal: if Assigned(Rule) then
-          Attributs := '<' + Rule.Name + '>' + Attributs;
-            else Attributs := '<?>' + Attributs;
+          itTerminal: begin
+            Attributs := Character + Attributs;
+            AddChild(NewTreeNode, Attributs);
+          end;
+          itNonterminal: begin
+            if Assigned(Rule) then begin
+              if Rule.Ownership = ARule then
+                ShowGrammerRule(NewTreeNode, Rule, Attributs)
+                else AddChild(NewTreeNode, '<' + Rule.Name + '>' + Attributs);
+            end else AddChild(NewTreeNode, '<?>' + Attributs);
+          end;
         end;
-        AddChild(NewTreeNode, Attributs);
       end;
     end;
+end;
+
+procedure TMainForm.ShowGrammerTree(Grammer: TGrammer);
+var
+  I: Integer;
+begin
+  with Grammer, TreeView2, Items do begin
+    BeginUpdate;
+    Clear;
+    TopItem := AddChild(nil, 'Gramatika');
+    for I := 0 to Rules.Count - 1 do with TGrammerRule(Rules[I]) do
+      if Ownership = nil then ShowGrammerRule(TopItem, TGrammerRule(Rules[I]));
     TopItem.Expand(False);
     EndUpdate;