Changeset 118 for branches/generator/Forms

Timestamp:

Nov 27, 2017, 5:10:04 PM (7 years ago)

Author:

chronos

Message:

• Added: Action to produce compiler files.

Location:

branches/generator/Forms

Files:

• UFormMain.lfm (modified) (4 diffs)
• UFormMain.pas (modified) (4 diffs)
• UFormRuleItem.pas (modified) (1 diff)

branches/generator/Forms/UFormMain.lfm

@@ -36 +36 @@
       Height = 22
       Top = 5
-      Width = 24
+      Width = 47
       Align = alNone
       AutoSize = True
@@ -54 +54 @@
         Action = ARules
       end
+      object ToolButton2: TToolButton
+        Left = 24
+        Top = 0
+        Action = ABuildCompiler
+      end
     end
   end
   object MainMenu1: TMainMenu
     Images = Core.ImageList1
-    left = 248
-    top = 216
+    left = 312
+    top = 229
     object MenuItem2: TMenuItem
       Caption = 'File'
@@ -73 +78 @@
       object MenuItem7: TMenuItem
         Action = AExit
+      end
+    end
+    object MenuItem8: TMenuItem
+      Caption = 'Tools'
+      object MenuItem9: TMenuItem
+        Action = ABuildCompiler
       end
     end
@@ -110 +121 @@
       OnExecute = ASaveAsExecute
     end
+    object ABuildCompiler: TAction
+      Caption = 'Build compiler'
+      ImageIndex = 9
+      OnExecute = ABuildCompilerExecute
+    end
   end
   object OpenDialog1: TOpenDialog

branches/generator/Forms/UFormMain.pas

@@ -7 +7 @@
 uses
   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
-  Menus, ActnList, ComCtrls, UPersistentForm;
+  Menus, ActnList, ComCtrls, UPersistentForm, URules;
 
 type
@@ -14 +14 @@
 
   TFormMain = class(TForm)
+    ABuildCompiler: TAction;
     AExit: TAction;
     AOpen: TAction;
@@ -29 +30 @@
     MenuItem6: TMenuItem;
     MenuItem7: TMenuItem;
+    MenuItem8: TMenuItem;
+    MenuItem9: TMenuItem;
     OpenDialog1: TOpenDialog;
     SaveDialog1: TSaveDialog;
     ToolBar1: TToolBar;
     ToolButton1: TToolButton;
+    ToolButton2: TToolButton;
+    procedure ABuildCompilerExecute(Sender: TObject);
     procedure AExitExecute(Sender: TObject);
     procedure AOpenExecute(Sender: TObject);
@@ -93 +98 @@
 end;
 
+procedure TFormMain.ABuildCompilerExecute(Sender: TObject);
+var
+  ParserFile: TStringList;
+  SourceFile: TStringList;
+  Rule: TRule;
+  Item: TRuleItem;
+  OutputDir: string;
+  Line: string;
+  I: Integer;
+begin
+  OutputDir := 'Generated';
+  ForceDirectories(OutputDir);
+
+  ParserFile := TStringList.Create;
+  with ParserFile do begin
+    Add('program Compiler;');
+    Add('');
+    Add('{$MODE Delphi}');
+    Add('');
+    Add('uses');
+    Add('  Source;');
+    Add('');
+    Add('procedure Compile;');
+    Add('begin');
+    Add('end;');
+    Add('');
+    Add('begin');
+    Add('  Compile;');
+    Add('end.');
+    SaveToFile(OutputDir + DirectorySeparator + 'Compiler.pas');
+  end;
+  FreeAndNil(ParserFile);
+
+  SourceFile := TStringList.Create;
+  with SourceFile do begin
+    Add('unit Source;');
+    Add('');
+    Add('{$MODE Delphi}');
+    Add('');
+    Add('interface');
+    Add('');
+    Add('uses');
+    Add('  fgl;');
+    Add('');
+    Add('type');
+    for Rule in Core.Grammer.Rules do begin
+      Add('  T' + Rule.Name + ' = class;');
+    end;
+    Add('');
+    for Rule in Core.Grammer.Rules do begin
+      Add('  T' + Rule.Name + ' = class');
+      for Item in Rule.Items do begin
+        if Item.RuleItemType = ritNonTerminal then
+          if Item.Repetitive then
+          Add('    ' + Item.NonTerminal.Name + ': TFPGObjectList<T' + Item.NonTerminal.Name + '>;')
+          else Add('    ' + Item.NonTerminal.Name + ': T' + Item.NonTerminal.Name + ';');
+      end;
+      Add('  end;' + LineEnding);
+    end;
+    Add('');
+    Add('implementation');
+    Add('');
+    for Rule in Core.Grammer.Rules do begin
+      Add('function Parse' + Rule.Name + ': Boolean;');
+      Add('begin');
+      I := 0;
+      for Item in Rule.Items do begin
+        Line := '  ';
+        if Rule.Items.RuleType = rtOr then begin
+          if I > 0 then Line := Line + 'else ';
+          Line := Line + 'if ';
+        end else
+        if Rule.Items.RuleType = rtAnd then begin
+          Line := Line + '';
+        end;
+        if Item.RuleItemType = ritTerminal then
+          Line := Line + 'Expect(''' + Item.Terminal + ''')'
+        else if Item.RuleItemType = ritNonTerminal then
+          Line := Line + 'Parse' + Item.NonTerminal.Name;
+        if Rule.Items.RuleType = rtOr then begin
+          Line := Line + ' then ';
+        end else
+        if Rule.Items.RuleType = rtAnd then begin
+          Line := Line + ';';
+        end;
+        Add(Line);
+        Inc(I);
+      end;
+      if Rule.Items.RuleType = rtOr then begin
+        Add('  else ShowError(''Unexpected token'');');
+      end;
+      Add('end;');
+      Add('');
+    end;
+
+    Add('end.');
+
+    SaveToFile(OutputDir + DirectorySeparator +'Source.pas');
+  end;
+  FreeAndNil(SourceFile);
+end;
+
 procedure TFormMain.AOpenExecute(Sender: TObject);
 begin

branches/generator/Forms/UFormRuleItem.pas

@@ -94 +94 @@
     ComboBoxNonTerminal.Items.AddObject(Rule.Name, Rule);
   end;
+  ComboBoxNonTerminal.Sorted := True;
 end;