Changeset 118 for branches/generator/Forms/UFormMain.pas

Timestamp:

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

Author:

chronos

Message:

• Added: Action to produce compiler files.

File:

• branches/generator/Forms/UFormMain.pas (modified) (4 diffs)

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