Changeset 132 for branches


Ignore:
Timestamp:
Dec 25, 2017, 11:54:43 AM (7 years ago)
Author:
chronos
Message:
  • Modified: Improved parser generation.
Location:
branches/generator
Files:
4 added
2 edited

Legend:

Unmodified
Added
Removed

  • branches/generator/Forms/UFormMain.lfm

    r131 r132  
    2929      Height = 28
    3030      Top = 5
    31       Width = 171
     31      Width = 169
    3232      Align = alNone
    3333      AutoSize = True
    … …  
    4242      Transparent = True
    4343      object ToolButton2: TToolButton
    44         Left = 142
     44        Left = 140
    4545        Top = 0
    4646        Action = ABuildCompiler
    … …  
    5656        Action = AProjectOpen
    5757        DropdownMenu = PopupMenuOpenRecent
    58         Style = tbsButtonDrop
     58        Style = tbsDropDown
    5959      end
    6060      object ToolButton5: TToolButton
    61         Left = 76
     61        Left = 74
    6262        Top = 0
    6363        Action = AProjectSave
    6464      end
    6565      object ToolButton6: TToolButton
    66         Left = 134
     66        Left = 132
    6767        Height = 28
    6868        Top = 0
    … …  
    7070      end
    7171      object ToolButton1: TToolButton
    72         Left = 105
     72        Left = 103
    7373        Top = 0
    7474        Action = AGrammerSettings

  • branches/generator/UBuilder.pas

    r129 r132  
    66
    77uses
    8   Classes, SysUtils, UGrammer;
     8  Classes, SysUtils, UGrammer, StrUtils;
    99
    1010type
    … …  
    1414  TBuilder = class
    1515  private
    16     function BuildTokenizerItems(SourceFile: TStrings; Items: TRuleItems): string;
    17     function GetItemString(Item: TRuleItem; Required: Boolean): string;
     16    function GetItemString(Item: TRuleItem; Required: Boolean; IndentLevel: Integer): string;
    1817    function StringText(Text: string): string;
    1918    procedure BuildMain(FileName: string);
    2019    procedure BuildParser(FileName: string);
     20    function BuildParserItems(Items: TRuleItems; IndentLevel: Integer): string;
    2121    procedure BuildSource(FileName: string);
    2222    procedure BuildTokenizer(FileName: string);
     23    function BuildTokenizerItems(SourceFile: TStrings; Items: TRuleItems): string;
    2324  public
    2425    Grammer: TGrammer;
    … …  
    3233implementation
    3334
    34 function TBuilder.GetItemString(Item: TRuleItem; Required: Boolean): string;
     35function TBuilder.GetItemString(Item: TRuleItem; Required: Boolean; IndentLevel: Integer): string;
    3536begin
    3637  Result := '';
    … …  
    4243      StringText(Item.TerminalFrom) + ''', ''' +
    4344      StringText(Item.TerminalTo) + ''', ' + BooleanText[Required] + ')';
    44     //ritSubItems: Line := 'Parse +';
     45    ritSubItems: begin
     46      Result := DupeString('  ', IndentLevel) + 'begin' + LineEnding;
     47      Result := Result + BuildParserItems(Item.SubItems, IndentLevel + 1);
     48      Result := Result + DupeString('  ', IndentLevel) + 'end';
     49    end;
    4550  end;
    4651end;
    … …  
    5560  ParserFile: TStringList;
    5661  Rule: TRule;
    57   I: Integer;
    58   Line: string;
    59   Item: TRuleItem;
    60   Required: Boolean;
    6162begin
    6263  ParserFile := TStringList.Create;
    … …  
    8485      Add('    function Parse' + Rule.Name + '(Required: Boolean = False): Boolean;');
    8586    Add('    constructor Create;');
    86     Add('    constructor Destroy; override;');
     87    Add('    destructor Destroy; override;');
    8788    Add('  end;');
    8889    Add('');
    … …  
    9394    Add('begin');
    9495    Add('  Position := 1;');
    95     Add('  Parser.Tokenizer := TTokenizer.Create;');
    96     Add('end;');
    97     Add('');
    98     Add('constructor TParser.Destroy;');
    99     Add('begin');
    100     Add('  FreeAndNil(Parser);');
     96    Add('  Tokenizer := TTokenizer.Create;');
     97    Add('end;');
     98    Add('');
     99    Add('destructor TParser.Destroy;');
     100    Add('begin');
     101    Add('  FreeAndNil(Tokenizer);');
    101102    Add('end;');
    102103    Add('');
    … …  
    141142      Add('begin');
    142143      Add('  Result := True;');
    143       I := 0;
    144       for Item in Rule.Items do begin
    145         Required := not Item.Optional;
    146         Line := '  ';
    147         case Rule.Items.RuleType of
    148           rtOr: begin
    149             if I > 0 then Line := Line + 'else ';
    150             Line := Line + 'if ' + GetItemString(Item, False);
    151             Line := Line + ' then Exit';
    152           end;
    153           rtAnd: begin
    154             Line := Line + 'Result := Result and ';
    155             if Item.Optional then Line := Line + 'True;' + LineEnding;
    156             if Item.Repetitive then begin
    157               if not Item.Optional then
    158                 Line := Line + '  ' + GetItemString(Item, Required) + ';' + LineEnding;
    159               Line := Line + '  repeat' + LineEnding + '    if not ';
    160               Required := False;
    161             end;
    162             Line := Line + GetItemString(Item, Required);
    163             if Item.Repetitive then Line := Line + ' then Break;' + LineEnding + '  until False';
    164             Line := Line + ';' + LineEnding + '  if not Result then Exit;';
    165           end;
    166         end;
    167         Add(Line);
    168         Inc(I);
    169       end;
    170       case Rule.Items.RuleType of
    171         rtOr: begin
    172           Add('  else begin');
    173           Add('    Error(''Unexpected token'');');
    174           Add('    Result := False;');
    175           Add('  end;');
    176         end;
    177         //rtAnd: Add('  if not Result then ShowError('''')');
    178       end;
     144      Text := Text + BuildParserItems(Rule.Items, 1);
    179145      Add('end;');
    180146      Add('');
    … …  
    185151  end;
    186152  FreeAndNil(ParserFile);
     153end;
     154
     155function TBuilder.BuildParserItems(Items: TRuleItems; IndentLevel: Integer): string;
     156var
     157  I: Integer;
     158  Item: TRuleItem;
     159  Required: Boolean;
     160  Line: string;
     161begin
     162  Result := '';
     163  I := 0;
     164  for Item in Items do begin
     165    Required := not Item.Optional;
     166    Line := '';
     167    case Items.RuleType of
     168      rtOr: begin
     169        Line := Line + DupeString('  ', IndentLevel);
     170        if I > 0 then Line := Line + 'else ';
     171        Line := Line + 'if ' + GetItemString(Item, False, IndentLevel) +
     172          ' then Exit';
     173      end;
     174      rtAnd: begin
     175        if not Item.Optional and not (Item.RuleItemType = ritSubItems) then
     176          Line := Line + DupeString('  ', IndentLevel) + 'Result := Result and ';
     177        if Item.Repetitive then begin
     178          if not Item.Optional then
     179            Line := Line + DupeString('  ', IndentLevel) + GetItemString(Item, Required, IndentLevel) + ';' + LineEnding;
     180          Line := Line + DupeString('  ', IndentLevel) + 'repeat' + LineEnding + DupeString('  ', IndentLevel) + 'if not ';
     181          Required := False;
     182        end;
     183        Line := Line + GetItemString(Item, Required, IndentLevel);
     184        if Item.Repetitive then
     185          Line := Line + ' then Break;' + LineEnding +
     186          DupeString('  ', IndentLevel) + 'until False';
     187        Line := Line + ';' + LineEnding +
     188          DupeString('  ', IndentLevel) + 'if not Result then Exit;';
     189      end;
     190    end;
     191    Result := Result + Line + LineEnding;
     192    Inc(I);
     193  end;
     194  case Items.RuleType of
     195    rtOr: begin
     196      Result := Result + DupeString('  ', IndentLevel) + 'else begin' + LineEnding;
     197      Result := Result + DupeString('  ', IndentLevel) + '  Error(''Unexpected token'');' + LineEnding;
     198      Result := Result + DupeString('  ', IndentLevel) + '  Result := False;' + LineEnding;
     199      Result := Result + DupeString('  ', IndentLevel) + 'end;' + LineEnding;
     200    end;
     201  end;
    187202end;
    188203
Note: See TracChangeset for help on using the changeset viewer.