Changeset 127 for branches/generator/URules.pas

Timestamp:

Nov 30, 2017, 5:19:57 PM (7 years ago)

Author:

chronos

Message:

• Fixed: Correctly set filename in open/save dialog.
• Modified: Improved generation of compiler code.

File:

• branches/generator/URules.pas (modified) (10 diffs)

branches/generator/URules.pas

@@ -110 +110 @@
   private
     FModified: Boolean;
+    function GetItemString(Item: TRuleItem; Required: Boolean): string;
     procedure SetModified(AValue: Boolean);
     procedure BuildParser(FileName: string);
@@ -131 +132 @@
 implementation
 
+const
+  BooleanText: array[Boolean] of string = ('False', 'True');
+
 { TGrammer }
+
+function TGrammer.GetItemString(Item: TRuleItem; Required: Boolean): string;
+begin
+  Result := '';
+  case Item.RuleItemType of
+    ritTerminal: Result := 'Expect(''' +
+      StringReplace(Item.Terminal, '''', '''''', [rfReplaceAll]) + ''', ' + BooleanText[Required] + ')';
+    ritNonTerminal: Result := 'Parse' + Item.NonTerminal.Name + '(' + BooleanText[Required] + ')';
+    ritTerminalRange: Result := 'ExpectRange(''' +
+      StringReplace(Item.TerminalFrom, '''', '''''', [rfReplaceAll]) + ''', ''' +
+      StringReplace(Item.TerminalTo, '''', '''''', [rfReplaceAll]) + ''', ' + BooleanText[Required] + ')';
+    //ritSubItems: Line := 'Parse +';
+  end;
+end;
 
 procedure TGrammer.SetModified(AValue: Boolean);
@@ -146 +164 @@
   Line: string;
   Item: TRuleItem;
+  Required: Boolean;
 begin
   ParserFile := TStringList.Create;
@@ -155 +174 @@
     Add('interface');
     Add('');
+    Add('uses');
+    Add('  SysUtils;');
+    Add('');
     Add('type');
     Add('  TParser = class');
     Add('    Content: string;');
+    Add('    FileName: string;');
     Add('    Position: Integer;');
     Add('    procedure Error(Text: string);');
@@ -163 +186 @@
     Add('    function ExpectRange(CharFrom, CharTo: Char; Required: Boolean = False): Boolean;');
     for Rule in Rules do
-      Add('    function Parse' + Rule.Name + ': Boolean;');
+      Add('    function Parse' + Rule.Name + '(Required: Boolean = False): Boolean;');
     Add('    constructor Create;');
     Add('  end;');
@@ -176 +199 @@
     Add('procedure TParser.Error(Text: string);');
     Add('begin');
-    Add('  WriteLn(''Error: '' + Text);');
+    Add('  WriteLn(FileName + ''('' + IntToStr(Position) + '') Error: '' + Text);');
     Add('end;');
     Add('');
@@ -182 +205 @@
     Add('var');
     Add('  ReadText: string;');
+    Add('  StartPos: Integer;');
     Add('begin');
+    Add('  StartPos := Position;');
     Add('  ReadText := Copy(Content, Position, Length(Text));');
     Add('  Inc(Position, Length(Text));');
     Add('  Result := Text = ReadText;');
-    Add('  if not Result and Required then Error(''Expected '' + Text + '' but found '' + ReadText + ''.'');');
+    Add('  if not Result then begin');
+    Add('    Position := StartPos;');
+    Add('    if Required then Error(''Expected "'' + Text + ''" but found "'' + ReadText + ''".'');');
+    Add('  end;');
     Add('end;');
     Add('');
@@ -192 +220 @@
     Add('var');
     Add('  ReadChar: Char;');
+    Add('  StartPos: Integer;');
     Add('begin');
+    Add('  StartPos := Position;');
     Add('  ReadChar := Content[Position];');
     Add('  Inc(Position, 1);');
     Add('  Result := (ReadChar >= CharFrom) and (ReadChar <= CharTo);');
-    Add('  if not Result and Required then Error(''Expected '' + CharFrom + '' to '' + CharTo + '' but found '' + ReadChar + ''.'');');
+    Add('  if not Result then begin');
+    Add('    Position := StartPos;');
+    Add('    if Required then Error(''Expected "'' + CharFrom + ''" to "'' + CharTo + ''" but found "'' + ReadChar + ''".'');');
+    Add('  end;');
     Add('end;');
     Add('');
     for Rule in Rules do begin
-      Add('function TParser.Parse' + Rule.Name + ': Boolean;');
+      Add('function TParser.Parse' + Rule.Name + '(Required: Boolean = False): Boolean;');
       Add('begin');
+      Add('  Result := True;');
       I := 0;
       for Item in Rule.Items do begin
+        Required := not Item.Optional;
         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;
-        case Item.RuleItemType of
-          ritTerminal: Line := Line + 'Expect(''' + StringReplace(Item.Terminal, '''', '''''', [rfReplaceAll]) + ''')';
-          ritNonTerminal: Line := Line + 'Parse' + Item.NonTerminal.Name;
-          ritTerminalRange: Line := Line + 'ExpectRange(''' + Item.TerminalFrom + ''', ''' + Item.TerminalTo + ''')';
-          //ritSubItems: Line := 'Parse +';
-        end;
-        if Rule.Items.RuleType = rtOr then begin
-          Line := Line + ' then ';
-        end else
-        if Rule.Items.RuleType = rtAnd then begin
-          Line := Line + ';';
+        case Rule.Items.RuleType of
+          rtOr: begin
+            if I > 0 then Line := Line + 'else ';
+            Line := Line + 'if ' + GetItemString(Item, False);
+            Line := Line + ' then Exit';
+          end;
+          rtAnd: begin
+            Line := Line + 'Result := Result and ';
+            if Item.Optional then Line := Line + 'True;' + LineEnding;
+            if Item.Repetitive then begin
+              if not Item.Optional then
+                Line := Line + '  ' + GetItemString(Item, Required) + ';' + LineEnding;
+              Line := Line + '  repeat' + LineEnding + '    if not ';
+              Required := False;
+            end;
+            Line := Line + GetItemString(Item, Required);
+            if Item.Repetitive then Line := Line + ' then Break;' + LineEnding + '  until False';
+            Line := Line + ';' + LineEnding + '  if not Result then Exit;';
+          end;
         end;
         Add(Line);
         Inc(I);
       end;
-      if Rule.Items.RuleType = rtOr then begin
-        Add('  else ShowError(''Unexpected token'');');
+      case Rule.Items.RuleType of
+        rtOr: begin
+          Add('  else begin');
+          Add('    Error(''Unexpected token'');');
+          Add('    Result := False;');
+          Add('  end;');
+        end;
+        //rtAnd: Add('  if not Result then ShowError('''')');
       end;
       Add('end;');
@@ -251 +293 @@
     Add('');
     Add('uses');
-    Add('  Source, Parser;');
+    Add('  Source, Parser, SysUtils;');
     Add('');
     Add('procedure Compile(FileName: string);');
@@ -262 +304 @@
     Add('  Reset(SourceFile);');
     Add('  Parser := TParser.Create;');
+    Add('  Parser.FileName := ExtractFileName(FileName);');
     Add('  SetLength(Parser.Content, FileSize(SourceFile));');
     Add('  I := 1;');