Changeset 7

Timestamp:

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

Author:

george

Message:

Tvorba gramatiky pascalu

Files:

• UGrammer.pas (modified) (11 diffs)
• UMainForm.dfm (modified) (3 diffs)
• UMainForm.pas (modified) (6 diffs)

UGrammer.pas

@@ -4 +4 @@
 
 uses
-  Classes, ComCtrls;
+  Classes, ComCtrls, SysUtils;
 
 type
@@ -50 +50 @@
     procedure DeleteEmpty;
     procedure MergeNonterminal(ARule: TGrammerRule);
+    procedure Join(ARule: TGrammerRule; ItemIndex: Integer);
     function MergeToTerminal: string;
     constructor Create;
     destructor Destroy; override;
+    procedure Assign(Source: TProgramItem);
   end;
 
@@ -65 +67 @@
   TGrammerItem = record
   private
+    Processed: Boolean;
     Parent: TGrammerRule;
-    Processed: Boolean;
   public
     ItemType: TRuleItemType;
     Character: Char;
     Rule: TGrammerRule;
+    RuleName: string;
     Optional: Boolean;
     Repetition: Boolean;
@@ -80 +83 @@
   private
   public
+    Ownership: TGrammerRule;
     Name: string;
     RuleType: TRuleType;
     Items: array of TGrammerItem;
     procedure ClearProcessed;
+    function Add: TGrammerItem;
     procedure AddTerminal(Character: Char; Optional, Repetition: Boolean);
     procedure AddTerminalText(Text: string);
@@ -100 +105 @@
     procedure ClearProcessed;
     procedure Parse(Text: string; var ParsedProgram: TProgram);
+    procedure CorrectRuleLinks;
     destructor Destroy; override;
   end;
@@ -106 +112 @@
 implementation
 
+uses
+  UMainForm;
+
 { TGrammerRule }
+
+function TGrammerRule.Add: TGrammerItem;
+begin
+  SetLength(Items, Length(Items) + 1);
+  Result := Items[High(Items)];
+  Result.Parent := Self;
+end;
 
 procedure TGrammerRule.AddRule(Rule: TGrammerRule; Optional,
@@ -147 +163 @@
 constructor TGrammerRule.Create;
 begin
-
+  Ownership := nil;
 end;
 
@@ -225 +241 @@
   for I := 0 to Rules.Count - 1 do with TGrammerRule(Rules[I]) do begin
     ClearProcessed;
+  end;
+end;
+
+procedure TGrammer.CorrectRuleLinks;
+var
+  I: Integer;
+  II: Integer;
+  J: Integer;
+begin
+  for I := 0 to Rules.Count - 1 do with TGrammerRule(Rules[I]) do begin
+    for II := 0 to Length(Items) - 1 do with Items[II] do begin
+      if (ItemType = itNonterminal) and (Rule = nil) then begin
+        J := 0;
+        while (J < Rules.Count) and (TGrammerRule(Rules[J]).Name <> RuleName)  do Inc(J);
+        if J < Rules.Count then Rule := Rules[J] else
+          raise Exception.Create('Rule link correction failed on rule ' +
+            IntToStr(I) + ' item ' + IntToStr(II));
+      end;
+    end;
   end;
 end;
@@ -294 +329 @@
           ExpectedCharacters := ExpectedCharacters + Scope.Items[II].Character;
         //raise Exception.Create('Parse error. Expected "' + ExpectedCharacters + '" but found "' + Text[I] + '".');
+        MainForm.Label1.Caption := 'Parse error. Expected "' + ExpectedCharacters + '" but found "' + Text[I] + '".';
         break;
       end;
@@ -361 +397 @@
 { TProgramItem }
 
+procedure TProgramItem.Assign(Source: TProgramItem);
+begin
+  
+end;
+
 constructor TProgramItem.Create;
 begin
@@ -423 +464 @@
   Items.Free;
   inherited;
+end;
+
+procedure TProgramItem.Join(ARule: TGrammerRule; ItemIndex: Integer);
+var
+  SubProgramItem: TProgramItem;
+  I: Integer;
+begin
+  if (ItemType = itNonterminal) and (Rule = ARule) then begin
+    SubProgramItem := TProgramItem(Items[ItemIndex]);
+    RuleBefore := SubProgramItem.RuleBefore;
+    Rule := SubProgramItem.Rule;
+    ItemType := SubProgramItem.ItemType;
+    Value := SubProgramItem.Value;
+    Items[ItemIndex] := nil;
+    for I := 0 to Items.Count - 1 do
+      if Assigned(Items[I]) then TProgramItem(Items[I]).Free;
+    Items := SubProgramItem.Items;
+  end;
+  for I := 0 to Items.Count - 1 do
+    TProgramItem(Items[I]).Join(ARule, ItemIndex);
 end;
 

UMainForm.dfm

@@ -21 +21 @@
   PixelsPerInch = 96
   TextHeight = 13
+  object Label1: TLabel
+    Left = 8
+    Top = 297
+    Width = 3
+    Height = 13
+  end
   object Memo1: TMemo
     Left = 8
     Top = 8
-    Width = 290
-    Height = 313
+    Width = 346
+    Height = 283
     ScrollBars = ssBoth
     TabOrder = 0
@@ -31 +37 @@
   object Button1: TButton
     Left = 304
-    Top = 8
+    Top = 297
     Width = 50
     Height = 25
@@ -56 +62 @@
     TabOrder = 3
   end
+  object Button2: TButton
+    Left = 232
+    Top = 297
+    Width = 66
+    Height = 25
+    Caption = 'Analyze'
+    TabOrder = 4
+    OnClick = Button2Click
+  end
 end

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;