Changeset 132 for branches/generator/UBuilder.pas

Timestamp:

Dec 25, 2017, 11:54:43 AM (7 years ago)

Author:

chronos

Message:

• Modified: Improved parser generation.

File:

• branches/generator/UBuilder.pas (modified) (9 diffs)

branches/generator/UBuilder.pas

@@ -6 +6 @@
 
 uses
-  Classes, SysUtils, UGrammer;
+  Classes, SysUtils, UGrammer, StrUtils;
 
 type
@@ -14 +14 @@
   TBuilder = class
   private
-    function BuildTokenizerItems(SourceFile: TStrings; Items: TRuleItems): string;
-    function GetItemString(Item: TRuleItem; Required: Boolean): string;
+    function GetItemString(Item: TRuleItem; Required: Boolean; IndentLevel: Integer): string;
     function StringText(Text: string): string;
     procedure BuildMain(FileName: string);
     procedure BuildParser(FileName: string);
+    function BuildParserItems(Items: TRuleItems; IndentLevel: Integer): string;
     procedure BuildSource(FileName: string);
     procedure BuildTokenizer(FileName: string);
+    function BuildTokenizerItems(SourceFile: TStrings; Items: TRuleItems): string;
   public
     Grammer: TGrammer;
@@ -32 +33 @@
 implementation
 
-function TBuilder.GetItemString(Item: TRuleItem; Required: Boolean): string;
+function TBuilder.GetItemString(Item: TRuleItem; Required: Boolean; IndentLevel: Integer): string;
 begin
   Result := '';
@@ -42 +43 @@
       StringText(Item.TerminalFrom) + ''', ''' +
       StringText(Item.TerminalTo) + ''', ' + BooleanText[Required] + ')';
-    //ritSubItems: Line := 'Parse +';
+    ritSubItems: begin
+      Result := DupeString('  ', IndentLevel) + 'begin' + LineEnding;
+      Result := Result + BuildParserItems(Item.SubItems, IndentLevel + 1);
+      Result := Result + DupeString('  ', IndentLevel) + 'end';
+    end;
   end;
 end;
@@ -55 +60 @@
   ParserFile: TStringList;
   Rule: TRule;
-  I: Integer;
-  Line: string;
-  Item: TRuleItem;
-  Required: Boolean;
 begin
   ParserFile := TStringList.Create;
@@ -84 +85 @@
       Add('    function Parse' + Rule.Name + '(Required: Boolean = False): Boolean;');
     Add('    constructor Create;');
-    Add('    constructor Destroy; override;');
+    Add('    destructor Destroy; override;');
     Add('  end;');
     Add('');
@@ -93 +94 @@
     Add('begin');
     Add('  Position := 1;');
-    Add('  Parser.Tokenizer := TTokenizer.Create;');
-    Add('end;');
-    Add('');
-    Add('constructor TParser.Destroy;');
-    Add('begin');
-    Add('  FreeAndNil(Parser);');
+    Add('  Tokenizer := TTokenizer.Create;');
+    Add('end;');
+    Add('');
+    Add('destructor TParser.Destroy;');
+    Add('begin');
+    Add('  FreeAndNil(Tokenizer);');
     Add('end;');
     Add('');
@@ -141 +142 @@
       Add('begin');
       Add('  Result := True;');
-      I := 0;
-      for Item in Rule.Items do begin
-        Required := not Item.Optional;
-        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;
-      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;
+      Text := Text + BuildParserItems(Rule.Items, 1);
       Add('end;');
       Add('');
@@ -185 +151 @@
   end;
   FreeAndNil(ParserFile);
+end;
+
+function TBuilder.BuildParserItems(Items: TRuleItems; IndentLevel: Integer): string;
+var
+  I: Integer;
+  Item: TRuleItem;
+  Required: Boolean;
+  Line: string;
+begin
+  Result := '';
+  I := 0;
+  for Item in Items do begin
+    Required := not Item.Optional;
+    Line := '';
+    case Items.RuleType of
+      rtOr: begin
+        Line := Line + DupeString('  ', IndentLevel);
+        if I > 0 then Line := Line + 'else ';
+        Line := Line + 'if ' + GetItemString(Item, False, IndentLevel) +
+          ' then Exit';
+      end;
+      rtAnd: begin
+        if not Item.Optional and not (Item.RuleItemType = ritSubItems) then
+          Line := Line + DupeString('  ', IndentLevel) + 'Result := Result and ';
+        if Item.Repetitive then begin
+          if not Item.Optional then
+            Line := Line + DupeString('  ', IndentLevel) + GetItemString(Item, Required, IndentLevel) + ';' + LineEnding;
+          Line := Line + DupeString('  ', IndentLevel) + 'repeat' + LineEnding + DupeString('  ', IndentLevel) + 'if not ';
+          Required := False;
+        end;
+        Line := Line + GetItemString(Item, Required, IndentLevel);
+        if Item.Repetitive then
+          Line := Line + ' then Break;' + LineEnding +
+          DupeString('  ', IndentLevel) + 'until False';
+        Line := Line + ';' + LineEnding +
+          DupeString('  ', IndentLevel) + 'if not Result then Exit;';
+      end;
+    end;
+    Result := Result + Line + LineEnding;
+    Inc(I);
+  end;
+  case Items.RuleType of
+    rtOr: begin
+      Result := Result + DupeString('  ', IndentLevel) + 'else begin' + LineEnding;
+      Result := Result + DupeString('  ', IndentLevel) + '  Error(''Unexpected token'');' + LineEnding;
+      Result := Result + DupeString('  ', IndentLevel) + '  Result := False;' + LineEnding;
+      Result := Result + DupeString('  ', IndentLevel) + 'end;' + LineEnding;
+    end;
+  end;
 end;