Changeset 127 for branches


Ignore:
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.
Location:
branches/generator
Files:
3 added
6 edited

Legend:

Unmodified
Added
Removed

  • branches/generator/Forms/UFormMain.lfm

    r126 r127  
    55  Width = 1050
    66  Caption = 'Language generator'
    7   ClientHeight = 644
     7  ClientHeight = 653
    88  ClientWidth = 1050
    99  Menu = MainMenu1
    … …  
    1111  OnCloseQuery = FormCloseQuery
    1212  OnShow = FormShow
    13   LCLVersion = '1.8.0.4'
     13  LCLVersion = '1.6.4.0'
    1414  object MemoBNF: TMemo
    1515    Left = 0
    16     Height = 609
     16    Height = 618
    1717    Top = 35
    1818    Width = 1050
    … …  
    3939      Height = 22
    4040      Top = 5
    41       Width = 47
     41      Width = 124
    4242      Align = alNone
    4343      AutoSize = True
    4444      BorderSpacing.Left = 22
    4545      BorderSpacing.Top = 3
    46       Caption = 'ToolBar1'
    4746      EdgeInner = esNone
    4847      EdgeOuter = esNone
    … …  
    5352      Transparent = True
    5453      object ToolButton1: TToolButton
    55         Left = 1
     54        Left = 78
    5655        Top = 0
    5756        Action = ARules
    5857      end
    5958      object ToolButton2: TToolButton
     59        Left = 101
     60        Top = 0
     61        Action = ABuildCompiler
     62      end
     63      object ToolButton3: TToolButton
     64        Left = 1
     65        Top = 0
     66        Action = AProjectNew
     67      end
     68      object ToolButton4: TToolButton
    6069        Left = 24
    6170        Top = 0
    62         Action = ABuildCompiler
     71        Action = AProjectOpen
     72      end
     73      object ToolButton5: TToolButton
     74        Left = 47
     75        Top = 0
     76        Action = AProjectSave
     77      end
     78      object ToolButton6: TToolButton
     79        Left = 70
     80        Height = 22
     81        Top = 0
     82        Width = 8
     83        Caption = 'ToolButton6'
     84        Style = tbsSeparator
    6385      end
    6486    end
    … …  
    6688  object MainMenu1: TMainMenu
    6789    Images = Core.ImageList1
    68     left = 312
     90    left = 304
    6991    top = 229
    7092    object MenuItem2: TMenuItem
    … …  
    161183  end
    162184  object OpenDialog1: TOpenDialog
     185    DefaultExt = '.grm'
     186    Filter = 'Grammer (.grm)|*.grm|All files|*.*'
    163187    left = 748
    164188    top = 188
    165189  end
    166190  object SaveDialog1: TSaveDialog
     191    DefaultExt = '.grm'
     192    Filter = 'Grammer (.grm)|*.grm|All files|*.*'
    167193    left = 587
    168194    top = 414

  • branches/generator/Forms/UFormMain.pas

    r126 r127  
    4545    ToolButton1: TToolButton;
    4646    ToolButton2: TToolButton;
     47    ToolButton3: TToolButton;
     48    ToolButton4: TToolButton;
     49    ToolButton5: TToolButton;
     50    ToolButton6: TToolButton;
    4751    procedure ABuildCompilerExecute(Sender: TObject);
    4852    procedure AExitExecute(Sender: TObject);
    … …  
    7882  SUnsavedChanges = 'Unsaved changes';
    7983  SDoYouWantToSaveProject = 'There are unsaved changes in project. Do you want to save them?';
    80   SNewGrammer = 'New grammer.xtg';
     84  SNewGrammer = 'New grammer.grm';
    8185
    8286  { TFormMain }
    … …  
    96100procedure TFormMain.AProjectSaveAsExecute(Sender: TObject);
    97101begin
    98   SaveDialog1.FileName := Core.Grammer.FileName;
     102  SaveDialog1.InitialDir := ExtractFileDir(Core.Grammer.FileName);
     103  SaveDialog1.FileName := ExtractFileName(Core.Grammer.FileName);
    99104  if SaveDialog1.Execute then begin
    100105    Core.LastOpenedFile := SaveDialog1.FileName;
    … …  
    192197  AProjectClose.Execute;
    193198  if not Assigned(Core.Grammer) then begin
    194     OpenDialog1.FileName := Core.LastOpenedFile;
     199    OpenDialog1.InitialDir := ExtractFileDir(Core.LastOpenedFile);
     200    OpenDialog1.FileName := ExtractFileName(Core.LastOpenedFile);
    195201    if OpenDialog1.Execute then begin
    196202      Core.LastOpenedFile := OpenDialog1.FileName;

  • branches/generator/URules.pas

    r126 r127  
    110110  private
    111111    FModified: Boolean;
     112    function GetItemString(Item: TRuleItem; Required: Boolean): string;
    112113    procedure SetModified(AValue: Boolean);
    113114    procedure BuildParser(FileName: string);
    … …  
    131132implementation
    132133
     134const
     135  BooleanText: array[Boolean] of string = ('False', 'True');
     136
    133137{ TGrammer }
     138
     139function TGrammer.GetItemString(Item: TRuleItem; Required: Boolean): string;
     140begin
     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;
     151end;
    134152
    135153procedure TGrammer.SetModified(AValue: Boolean);
    … …  
    146164  Line: string;
    147165  Item: TRuleItem;
     166  Required: Boolean;
    148167begin
    149168  ParserFile := TStringList.Create;
    … …  
    155174    Add('interface');
    156175    Add('');
     176    Add('uses');
     177    Add('  SysUtils;');
     178    Add('');
    157179    Add('type');
    158180    Add('  TParser = class');
    159181    Add('    Content: string;');
     182    Add('    FileName: string;');
    160183    Add('    Position: Integer;');
    161184    Add('    procedure Error(Text: string);');
    … …  
    163186    Add('    function ExpectRange(CharFrom, CharTo: Char; Required: Boolean = False): Boolean;');
    164187    for Rule in Rules do
    165       Add('    function Parse' + Rule.Name + ': Boolean;');
     188      Add('    function Parse' + Rule.Name + '(Required: Boolean = False): Boolean;');
    166189    Add('    constructor Create;');
    167190    Add('  end;');
    … …  
    176199    Add('procedure TParser.Error(Text: string);');
    177200    Add('begin');
    178     Add('  WriteLn(''Error: '' + Text);');
     201    Add('  WriteLn(FileName + ''('' + IntToStr(Position) + '') Error: '' + Text);');
    179202    Add('end;');
    180203    Add('');
    … …  
    182205    Add('var');
    183206    Add('  ReadText: string;');
     207    Add('  StartPos: Integer;');
    184208    Add('begin');
     209    Add('  StartPos := Position;');
    185210    Add('  ReadText := Copy(Content, Position, Length(Text));');
    186211    Add('  Inc(Position, Length(Text));');
    187212    Add('  Result := Text = ReadText;');
    188     Add('  if not Result and Required then Error(''Expected '' + Text + '' but found '' + 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;');
    189217    Add('end;');
    190218    Add('');
    … …  
    192220    Add('var');
    193221    Add('  ReadChar: Char;');
     222    Add('  StartPos: Integer;');
    194223    Add('begin');
     224    Add('  StartPos := Position;');
    195225    Add('  ReadChar := Content[Position];');
    196226    Add('  Inc(Position, 1);');
    197227    Add('  Result := (ReadChar >= CharFrom) and (ReadChar <= CharTo);');
    198     Add('  if not Result and Required then Error(''Expected '' + CharFrom + '' to '' + CharTo + '' but found '' + ReadChar + ''.'');');
     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;');
    199232    Add('end;');
    200233    Add('');
    201234    for Rule in Rules do begin
    202       Add('function TParser.Parse' + Rule.Name + ': Boolean;');
     235      Add('function TParser.Parse' + Rule.Name + '(Required: Boolean = False): Boolean;');
    203236      Add('begin');
     237      Add('  Result := True;');
    204238      I := 0;
    205239      for Item in Rule.Items do begin
     240        Required := not Item.Optional;
    206241        Line := '  ';
    207         if Rule.Items.RuleType = rtOr then begin
    208           if I > 0 then Line := Line + 'else ';
    209           Line := Line + 'if ';
    210         end else
    211         if Rule.Items.RuleType = rtAnd then begin
    212           Line := Line + '';
    213         end;
    214         case Item.RuleItemType of
    215           ritTerminal: Line := Line + 'Expect(''' + StringReplace(Item.Terminal, '''', '''''', [rfReplaceAll]) + ''')';
    216           ritNonTerminal: Line := Line + 'Parse' + Item.NonTerminal.Name;
    217           ritTerminalRange: Line := Line + 'ExpectRange(''' + Item.TerminalFrom + ''', ''' + Item.TerminalTo + ''')';
    218           //ritSubItems: Line := 'Parse +';
    219         end;
    220         if Rule.Items.RuleType = rtOr then begin
    221           Line := Line + ' then ';
    222         end else
    223         if Rule.Items.RuleType = rtAnd then begin
    224           Line := 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;
    225261        end;
    226262        Add(Line);
    227263        Inc(I);
    228264      end;
    229       if Rule.Items.RuleType = rtOr then begin
    230         Add('  else ShowError(''Unexpected token'');');
     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('''')');
    231273      end;
    232274      Add('end;');
    … …  
    251293    Add('');
    252294    Add('uses');
    253     Add('  Source, Parser;');
     295    Add('  Source, Parser, SysUtils;');
    254296    Add('');
    255297    Add('procedure Compile(FileName: string);');
    … …  
    262304    Add('  Reset(SourceFile);');
    263305    Add('  Parser := TParser.Create;');
     306    Add('  Parser.FileName := ExtractFileName(FileName);');
    264307    Add('  SetLength(Parser.Content, FileSize(SourceFile));');
    265308    Add('  I := 1;');

  • branches/generator/generator.lpi

    r126 r127  
    1212    </General>
    1313    <i18n>
    14       <EnableI18N LFM="False"/>
     14      <EnableI18N Value="True"/>
     15      <OutDir Value="Languages"/>
    1516    </i18n>
    1617    <BuildModes Count="2">
    … …  
    139140        <IsPartOfProject Value="True"/>
    140141        <ComponentName Value="FormGrammer"/>
     142        <HasResources Value="True"/>
    141143        <ResourceBaseClass Value="Form"/>
    142144      </Unit8>

  • branches/generator/pascal.grm

    r125 r127  
    19531953      </RuleItems>
    19541954    </Rule>
     1955    <Rule>
     1956      <Name>WhiteSpace</Name>
     1957      <CreateSourceNode>0</CreateSourceNode>
     1958      <RuleItems>
     1959        <Type>1</Type>
     1960        <RuleItem>
     1961          <Type>0</Type>
     1962          <Optional>0</Optional>
     1963          <Repetitive>0</Repetitive>
     1964          <AnyExcept>0</AnyExcept>
     1965          <Terminal> </Terminal>
     1966        </RuleItem>
     1967        <RuleItem>
     1968          <Type>0</Type>
     1969          <Optional>0</Optional>
     1970          <Repetitive>0</Repetitive>
     1971          <AnyExcept>0</AnyExcept>
     1972          <Terminal>#13</Terminal>
     1973        </RuleItem>
     1974        <RuleItem>
     1975          <Type>0</Type>
     1976          <Optional>0</Optional>
     1977          <Repetitive>0</Repetitive>
     1978          <AnyExcept>0</AnyExcept>
     1979          <Terminal>#10</Terminal>
     1980        </RuleItem>
     1981        <RuleItem>
     1982          <Type>0</Type>
     1983          <Optional>0</Optional>
     1984          <Repetitive>0</Repetitive>
     1985          <AnyExcept>0</AnyExcept>
     1986          <Terminal>#9</Terminal>
     1987        </RuleItem>
     1988      </RuleItems>
     1989    </Rule>
     1990    <Rule>
     1991      <Name>WhiteSpaces</Name>
     1992      <CreateSourceNode>0</CreateSourceNode>
     1993      <RuleItems>
     1994        <Type>0</Type>
     1995        <RuleItem>
     1996          <Type>1</Type>
     1997          <Optional>-1</Optional>
     1998          <Repetitive>-1</Repetitive>
     1999          <AnyExcept>0</AnyExcept>
     2000          <NonTerminal>WhiteSpace</NonTerminal>
     2001        </RuleItem>
     2002      </RuleItems>
     2003    </Rule>
    19552004  </Rules>
    19562005  <TopRule>Program</TopRule>
Note: See TracChangeset for help on using the changeset viewer.