Ignore:
Timestamp:
Dec 19, 2017, 4:56:34 PM (7 years ago)
Author:
chronos
Message:
  • Modified: Generate rules either to tokenizer and parser.
File:
1 moved

Legend:

Unmodified
Added
Removed

  • branches/generator/UGrammer.pas

    r128 r129  
    1 unit URules;
     1unit UGrammer;
    22
    33{$mode delphi}{$H+}
    … …  
    7575  end;
    7676
     77  TRuleLevel = (rlParser, rlTokenizer);
     78
    7779  { TRule }
    7880
    … …  
    8486    Name: string;
    8587    CreateSourceNode: Boolean;
     88    Level: TRuleLevel;
    8689    Items: TRuleItems;
    8790    Links: TRuleLinks;
    … …  
    110113  private
    111114    FModified: Boolean;
    112     function GetItemString(Item: TRuleItem; Required: Boolean): string;
    113115    procedure SetModified(AValue: Boolean);
    114     procedure BuildParser(FileName: string);
    115     procedure BuildMain(FileName: string);
    116     procedure BuildSource(FileName: string);
    117116  public
    118117    FileName: string;
    … …  
    124123    constructor Create;
    125124    destructor Destroy; override;
    126     procedure BuildCompiler;
    127125    procedure GetUsedByRule(RefRule: TRule; UsedByRules: TStrings);
    128126    function GetString: string;
    … …  
    130128  end;
    131129
     130const
     131  RuleLevelText: array[TRuleLevel] of string = ('Parser', 'Tokenizer');
     132  RuleTypeText: array[TRuleType] of string = ('and', 'or');
     133
     134
    132135implementation
    133136
    134 const
    135   BooleanText: array[Boolean] of string = ('False', 'True');
    136 
    137137{ TGrammer }
    138 
    139 function TGrammer.GetItemString(Item: TRuleItem; Required: Boolean): string;
    140 begin
    141   Result := '';
    142   case Item.RuleItemType of
    143     ritTerminal: Result := 'Expect(''' +
    144       StringReplace(Item.Terminal, '''', '''''', [rfReplaceAll]) + ''', ' + BooleanText[Required] + ')';
    145     ritNonTerminal: Result := 'Parse' + Item.NonTerminal.Name + '(' + BooleanText[Required] + ')';
    146     ritTerminalRange: Result := 'ExpectRange(''' +
    147       StringReplace(Item.TerminalFrom, '''', '''''', [rfReplaceAll]) + ''', ''' +
    148       StringReplace(Item.TerminalTo, '''', '''''', [rfReplaceAll]) + ''', ' + BooleanText[Required] + ')';
    149     //ritSubItems: Line := 'Parse +';
    150   end;
    151 end;
    152138
    153139procedure TGrammer.SetModified(AValue: Boolean);
    … …  
    155141  if FModified = AValue then Exit;
    156142  FModified := AValue;
    157 end;
    158 
    159 procedure TGrammer.BuildParser(FileName: string);
    160 var
    161   ParserFile: TStringList;
    162   Rule: TRule;
    163   I: Integer;
    164   Line: string;
    165   Item: TRuleItem;
    166   Required: Boolean;
    167 begin
    168   ParserFile := TStringList.Create;
    169   with ParserFile do begin
    170     Add('unit Parser;');
    171     Add('');
    172     Add('{$MODE Delphi}');
    173     Add('');
    174     Add('interface');
    175     Add('');
    176     Add('uses');
    177     Add('  SysUtils;');
    178     Add('');
    179     Add('type');
    180     Add('  TParser = class');
    181     Add('    Content: string;');
    182     Add('    FileName: string;');
    183     Add('    Position: Integer;');
    184     Add('    procedure Error(Text: string);');
    185     Add('    function Expect(Text: string; Required: Boolean = False): Boolean;');
    186     Add('    function ExpectRange(CharFrom, CharTo: Char; Required: Boolean = False): Boolean;');
    187     for Rule in Rules do
    188       Add('    function Parse' + Rule.Name + '(Required: Boolean = False): Boolean;');
    189     Add('    constructor Create;');
    190     Add('  end;');
    191     Add('');
    192     Add('implementation');
    193     Add('');
    194     Add('constructor TParser.Create;');
    195     Add('begin');
    196     Add('  Position := 1;');
    197     Add('end;');
    198     Add('');
    199     Add('procedure TParser.Error(Text: string);');
    200     Add('begin');
    201     Add('  WriteLn(FileName + ''('' + IntToStr(Position) + '') Error: '' + Text);');
    202     Add('end;');
    203     Add('');
    204     Add('function TParser.Expect(Text: string; Required: Boolean = False): Boolean;');
    205     Add('var');
    206     Add('  ReadText: string;');
    207     Add('  StartPos: Integer;');
    208     Add('begin');
    209     Add('  StartPos := Position;');
    210     Add('  ReadText := Copy(Content, Position, Length(Text));');
    211     Add('  Inc(Position, Length(Text));');
    212     Add('  Result := Text = ReadText;');
    213     Add('  if not Result then begin');
    214     Add('    Position := StartPos;');
    215     Add('    if Required then Error(''Expected "'' + Text + ''" but found "'' + ReadText + ''".'');');
    216     Add('  end;');
    217     Add('end;');
    218     Add('');
    219     Add('function TParser.ExpectRange(CharFrom, CharTo: char; Required: Boolean = False): Boolean;');
    220     Add('var');
    221     Add('  ReadChar: Char;');
    222     Add('  StartPos: Integer;');
    223     Add('begin');
    224     Add('  StartPos := Position;');
    225     Add('  ReadChar := Content[Position];');
    226     Add('  Inc(Position, 1);');
    227     Add('  Result := (ReadChar >= CharFrom) and (ReadChar <= CharTo);');
    228     Add('  if not Result then begin');
    229     Add('    Position := StartPos;');
    230     Add('    if Required then Error(''Expected "'' + CharFrom + ''" to "'' + CharTo + ''" but found "'' + ReadChar + ''".'');');
    231     Add('  end;');
    232     Add('end;');
    233     Add('');
    234     for Rule in Rules do begin
    235       Add('function TParser.Parse' + Rule.Name + '(Required: Boolean = False): Boolean;');
    236       Add('begin');
    237       Add('  Result := True;');
    238       I := 0;
    239       for Item in Rule.Items do begin
    240         Required := not Item.Optional;
    241         Line := '  ';
    242         case Rule.Items.RuleType of
    243           rtOr: begin
    244             if I > 0 then Line := Line + 'else ';
    245             Line := Line + 'if ' + GetItemString(Item, False);
    246             Line := Line + ' then Exit';
    247           end;
    248           rtAnd: begin
    249             Line := Line + 'Result := Result and ';
    250             if Item.Optional then Line := Line + 'True;' + LineEnding;
    251             if Item.Repetitive then begin
    252               if not Item.Optional then
    253                 Line := Line + '  ' + GetItemString(Item, Required) + ';' + LineEnding;
    254               Line := Line + '  repeat' + LineEnding + '    if not ';
    255               Required := False;
    256             end;
    257             Line := Line + GetItemString(Item, Required);
    258             if Item.Repetitive then Line := Line + ' then Break;' + LineEnding + '  until False';
    259             Line := Line + ';' + LineEnding + '  if not Result then Exit;';
    260           end;
    261         end;
    262         Add(Line);
    263         Inc(I);
    264       end;
    265       case Rule.Items.RuleType of
    266         rtOr: begin
    267           Add('  else begin');
    268           Add('    Error(''Unexpected token'');');
    269           Add('    Result := False;');
    270           Add('  end;');
    271         end;
    272         //rtAnd: Add('  if not Result then ShowError('''')');
    273       end;
    274       Add('end;');
    275       Add('');
    276     end;
    277     Add('');
    278     Add('end.');
    279     SaveToFile(FileName);
    280   end;
    281   FreeAndNil(ParserFile);
    282 end;
    283 
    284 procedure TGrammer.BuildMain(FileName: string);
    285 var
    286   ParserFile: TStringList;
    287 begin
    288   ParserFile := TStringList.Create;
    289   with ParserFile do begin
    290     Add('program Compiler;');
    291     Add('');
    292     Add('{$MODE Delphi}');
    293     Add('');
    294     Add('uses');
    295     Add('  Source, Parser, SysUtils;');
    296     Add('');
    297     Add('procedure Compile(FileName: string);');
    298     Add('var');
    299     Add('  SourceFile: file of Char;');
    300     Add('  Parser: TParser;');
    301     Add('  I: Integer;');
    302     Add('begin');
    303     Add('  AssignFile(SourceFile, FileName);');
    304     Add('  Reset(SourceFile);');
    305     Add('  Parser := TParser.Create;');
    306     Add('  Parser.FileName := ExtractFileName(FileName);');
    307     Add('  SetLength(Parser.Content, FileSize(SourceFile));');
    308     Add('  I := 1;');
    309     Add('  while not Eof(SourceFile) do begin');
    310     Add('    Read(SourceFile, Parser.Content[I]);');
    311     Add('    Inc(I);');
    312     Add('  end;');
    313     Add('  CloseFile(SourceFile);');
    314     if Assigned(TopRule) then
    315       Add('  Parser.Parse' + TopRule.Name + ';');
    316     Add('  Parser.Free;');
    317     Add('end;');
    318     Add('');
    319     Add('begin');
    320     Add('  if ParamCount > 0 then');
    321     Add('    Compile(ParamStr(1))');
    322     Add('    else WriteLn(''File name not specified as parameter.'');');
    323     Add('end.');
    324     SaveToFile(FileName);
    325   end;
    326   FreeAndNil(ParserFile);
    327 end;
    328 
    329 procedure TGrammer.BuildSource(FileName: string);
    330 var
    331   Rule: TRule;
    332   Item: TRuleItem;
    333   SourceFile: TStringList;
    334   TypeSectionStarted: Boolean;
    335 begin
    336   SourceFile := TStringList.Create;
    337   with SourceFile do begin
    338     Add('unit Source;');
    339     Add('');
    340     Add('{$MODE Delphi}');
    341     Add('');
    342     Add('interface');
    343     Add('');
    344     Add('uses');
    345     Add('  fgl;');
    346     Add('');
    347     TypeSectionStarted := False;
    348     for Rule in Rules do
    349     if Rule.CreateSourceNode then begin
    350       if not TypeSectionStarted then begin
    351         Add('type');
    352         TypeSectionStarted := True;
    353       end;
    354       Add('  T' + Rule.Name + ' = class;');
    355     end;
    356     Add('');
    357     for Rule in Rules do
    358     if Rule.CreateSourceNode then begin
    359       Add('  T' + Rule.Name + ' = class');
    360       for Item in Rule.Items do begin
    361         if Item.RuleItemType = ritNonTerminal then
    362           if Item.Repetitive then
    363           Add('    ' + Item.NonTerminal.Name + ': TFPGObjectList<T' + Item.NonTerminal.Name + '>;')
    364           else Add('    ' + Item.NonTerminal.Name + ': T' + Item.NonTerminal.Name + ';');
    365       end;
    366       Add('  end;' + LineEnding);
    367     end;
    368     Add('');
    369     Add('implementation');
    370     Add('');
    371 
    372     Add('end.');
    373 
    374     SaveToFile(FileName);
    375   end;
    376   FreeAndNil(SourceFile);
    377143end;
    378144
    … …  
    449215  FreeAndNil(Rules);
    450216  inherited Destroy;
    451 end;
    452 
    453 procedure TGrammer.BuildCompiler;
    454 var
    455   OutputDir: string;
    456 begin
    457   OutputDir := 'Generated';
    458   ForceDirectories(OutputDir);
    459 
    460   BuildMain(OutputDir + DirectorySeparator + 'Compiler.pas');
    461   BuildSource(OutputDir + DirectorySeparator + 'Source.pas');
    462   BuildParser(OutputDir + DirectorySeparator + 'Parser.pas');
    463217end;
    464218
    … …  
    666420  WriteString(Node, 'Name', Name);
    667421  WriteBoolean(Node, 'CreateSourceNode', CreateSourceNode);
     422  WriteInteger(Node, 'Level', Integer(Level));
    668423
    669424  RuleItemsNode := Node.OwnerDocument.CreateElement('RuleItems');
    … …  
    715470  Name := ReadString(Node, 'Name', '');
    716471  CreateSourceNode := ReadBoolean(Node, 'CreateSourceNode', False);
     472  Level := TRuleLevel(ReadInteger(Node, 'Level', 0));
    717473
    718474  ItemsNode := Node.FindNode('RuleItems');
Note: See TracChangeset for help on using the changeset viewer.