Ignore:
Timestamp:
Apr 25, 2011, 10:41:52 PM (13 years ago)
Author:
george
Message:
  • Added: Pl0 pascal grammer definition.
  • Added: Generation of source code for structure.
File:
1 edited

Legend:

Unmodified
Added
Removed

  • tools/Grammer/UMainForm.pas

    r31 r33  
    11unit UMainForm;
    22
    3 {$mode objfpc}{$H+}
     3{$mode Delphi}{$H+}
    44
    55interface
    … …  
    1616    Button1: TButton;
    1717    Button2: TButton;
    18     Button3: TButton;
     18    ButtonGenerate: TButton;
    1919    ButtonDump: TButton;
    2020    Edit1: TEdit;
    … …  
    2525    procedure Button1Click(Sender: TObject);
    2626    procedure Button2Click(Sender: TObject);
    27     procedure Button3Click(Sender: TObject);
     27    procedure ButtonGenerateClick(Sender: TObject);
    2828    procedure ButtonDumpClick(Sender: TObject);
    2929    procedure FormCreate(Sender: TObject);
    3030    procedure FormDestroy(Sender: TObject);
    3131  private
     32    LastIndex: Integer;
    3233    function DumpGroup(Group: TGrammerRule): string;
     34    function GenerateGroup(Group: TGrammerRule; Lines: TStrings): string;
     35    function GetFreeName(Name: string): string;
    3336    { private declarations }
    3437  public
    3538    Grammer: TGrammer;
    36     procedure InitPascal;
    37   end;
     39  end;
    3840
    3941var
    … …  
    4345
    4446{$R *.lfm}
     47
     48uses
     49  Pl0Grammer;
    4550
    4651{ TForm1 }
    … …  
    6873end;
    6974
    70 procedure TForm1.Button3Click(Sender: TObject);
    71 begin
    72 
     75procedure TForm1.ButtonGenerateClick(Sender: TObject);
     76  var
     77  I: Integer;
     78  Row: string;
     79begin
     80  Memo1.Clear;
     81  with Grammer do
     82  for I := 0 to Rules.Count - 1 do
     83  with TGrammerRule(Rules[I]) do begin
     84    Row := 'T' + Name + ' = class' + LineEnding;
     85    Row := Row + GenerateGroup(TGrammerRule(Rules[I]), Memo1.Lines);
     86    Row := Row + 'end;' + LineEnding;
     87    Memo1.Lines.Add(Row);
     88  end;
     89end;
     90
     91function TForm1.GenerateGroup(Group: TGrammerRule; Lines: TStrings): string;
     92var
     93  J: Integer;
     94  Item: string;
     95  UniqueName: string;
     96  SwitchItems: string;
     97  GroupContent: string;
     98  TypeName: string;
     99begin
     100  Result := '';
     101  SwitchItems := '';
     102  with Group do begin
     103    for J := 0 to Items.Count - 1 do
     104    with TGrammerRuleItem(Items[J]) do begin
     105      Item := '';
     106      if ItemType = itText then begin
     107          Item := ''
     108        end else
     109        if ItemType = itReference then begin
     110          UniqueName := GetFreeName(Text);
     111          if Text = 'Name' then TypeName := 'string'
     112          else if Text = 'Number' then TypeName := 'Integer'
     113          else TypeName := 'T' + Text;
     114          Item := '  ' + UniqueName + ': ' + TypeName + ';' + LineEnding;
     115          SwitchItems := SwitchItems + 'si' + UniqueName;
     116          if J < (Items.Count - 1) then SwitchItems := SwitchItems + ', ';
     117        end else
     118        if ItemType = itGroup then begin
     119          GroupContent := GenerateGroup(Group, Lines);
     120          if GroupContent <> '' then begin
     121            UniqueName := GetFreeName('Group');
     122            Item := '  ' + UniqueName + ': ';
     123            Lines.Add('T' + UniqueName + ' = class' + LineEnding +
     124              GroupContent + 'end' + LineEnding);
     125            if Repetition then begin
     126              Item := Item + 'TObjectList; // TList<T' + UniqueName + '>' + LineEnding
     127            end else Item := Item + 'T' + UniqueName + ';' + LineEnding;
     128
     129            SwitchItems := SwitchItems + 'si' + UniqueName;
     130            if J < (Items.Count - 1) then SwitchItems := SwitchItems + ', ';
     131          end;
     132        end else Item := '';
     133
     134        //else if Optional then Item := '[ ' + Item + ' ]';
     135      Result := Result + Item;
     136    end;
     137    if (RuleType = rtAlternative) then begin
     138      if SwitchItems <> '' then begin
     139        Lines.Add('T' + Name + 'Switch = (' + SwitchItems + ');');
     140        Result := Result + '  Switch: T' + Name + 'Switch;' + LineEnding;
     141      end;
     142    end;
     143  end;
     144end;
     145
     146function TForm1.GetFreeName(Name: string): string;
     147begin
     148  Inc(LastIndex);
     149  Result := Name + IntToStr(LastIndex);
    73150end;
    74151
    … …  
    96173    Result := Result + Item + ' ';
    97174  end;
    98 
    99175end;
    100176
    … …  
    104180  Row: string;
    105181begin
     182  Memo1.Clear;
    106183  with Grammer do
    107184  for I := 0 to Rules.Count - 1 do
    … …  
    116193procedure TForm1.FormCreate(Sender: TObject);
    117194begin
    118   Grammer := TGrammer.Create;
    119   InitPascal;
     195  Grammer := TPl0Grammer.Create;
    120196end;
    121197
    … …  
    125201end;
    126202
    127 procedure TForm1.InitPascal;
    128 begin
    129   with Grammer do begin
    130     Rules.Clear;
    131     with AddRule('program', rtSequence) do begin
    132       AddItem('block', itReference, False, False);
    133       AddItem('.', itText, False, False);
    134     end;
    135     with AddRule('block', rtSequence) do begin
    136       AddItem('declaration', itReference, True, False);
    137       AddItem('statement', itReference, False, False);
    138     end;
    139     with AddRule('declaration', rtAlternative) do begin
    140       AddItem('constant', itReference, False, False);
    141       AddItem('variable', itReference, False, False);
    142       AddItem('function', itReference, False, False);
    143     end;
    144     with AddRule('constant', rtSequence) do begin
    145       AddItem('const', itText, False, False);
    146       AddItem('constant_definition', itReference, False, False);
    147       with AddGroup(rtSequence, False, True), Items do begin
    148         AddItem(',', itText, False, False);
    149         AddItem('constant_definition', itReference, False, False);
    150       end;
    151       AddItem(';', itText, False, False);
    152     end;
    153     with AddRule('constant_definition', rtSequence) do begin
    154       AddItem('name', itReference, False, False);
    155       AddItem('=', itText, False, False);
    156       AddItem('number', itReference, False, False);
    157     end;
    158     with AddRule('variable', rtSequence) do begin
    159       AddItem('var', itText, False, False);
    160       AddItem('name', itReference, False, False);
    161       with AddGroup(rtSequence, False, True), Items do begin
    162         AddItem(',', itText, False, False);
    163         AddItem('name', itReference, False, False);
    164       end;
    165       AddItem(';', itText, False, False);
    166     end;
    167     with AddRule('function', rtSequence) do begin
    168       AddItem('function', itText, False, False);
    169       AddItem('name', itReference, False, False);
    170       AddItem('(', itText, False, False);
    171       with AddGroup(rtSequence, True, False), Items do begin
    172         AddItem('name', itReference, False, False);
    173         with AddGroup(rtSequence, False, True), Items do begin
    174           AddItem(',', itText, False, False);
    175           AddItem('name', itReference, False, False);
    176         end;
    177       end;
    178       AddItem(')', itText, False, False);
    179       AddItem('block', itReference, False, False);
    180       AddItem(';', itText, False, False);
    181     end;
    182     with AddRule('expression', rtSequence) do begin
    183       with AddGroup(rtAlternative, True, False), Items do begin
    184         AddItem('-', itText, False, False);
    185         AddItem('+', itText, False, False);
    186       end;
    187       AddItem('term', itReference, False, False);
    188       with AddGroup(rtSequence, False, True), Items do begin
    189         with AddGroup(rtAlternative, False, False), Items do begin
    190           AddItem('-', itText, False, False);
    191           AddItem('+', itText, False, False);
    192         end;
    193         AddItem('term', itReference, False, False);
    194       end;
    195     end;
    196     with AddRule('term', rtSequence) do begin
    197       AddItem('factor', itReference, False, False);
    198       with AddGroup(rtSequence, False, True), Items do begin
    199         with AddGroup(rtAlternative, False, False), Items do begin
    200           AddItem('*', itText, False, False);
    201           AddItem('/', itText, False, False);
    202         end;
    203         AddItem('factor', itReference, False, False);
    204       end;
    205     end;
    206     with AddRule('factor', rtAlternative) do begin
    207       with AddGroup(rtSequence, False, False), Items do begin
    208         AddItem('name', itReference, False, False);
    209         AddItem('(', itText, False, False);
    210         with AddGroup(rtSequence, True, False), Items do begin
    211           AddItem('expression', itReference, False, False);
    212           with AddGroup(rtSequence, False, True), Items do begin
    213             AddItem(',', itText, False, False);
    214             AddItem('expression', itReference, False, False);
    215           end;
    216         end;
    217         AddItem('(', itText, False, False);
    218       end;
    219       AddItem('number', itReference, False, False);
    220       AddItem('name', itReference, False, False);
    221       with AddGroup(rtSequence, False, False), Items do begin
    222         AddItem('(', itText, False, False);
    223         AddItem('expression', itReference, False, False);
    224         AddItem(')', itText, False, False);
    225       end;
    226     end;
    227     with AddRule('statement', rtSequence) do begin
    228       with AddGroup(rtAlternative, True, False), Items do begin
    229         with AddGroup(rtSequence, False, False), Items do begin
    230           AddItem('name', itReference, False, False);
    231           AddItem(':=', itText, False, False);
    232           AddItem('expression', itReference, False, False);
    233         end;
    234         with AddGroup(rtSequence, False, False), Items do begin
    235           AddItem('begin', itText, False, False);
    236           AddItem('statement', itReference, False, False);
    237           with AddGroup(rtSequence, False, True), Items do begin
    238             AddItem(',', itText, False, False);
    239             AddItem('statement', itReference, False, False);
    240           end;
    241           AddItem('end', itText, False, False);
    242         end;
    243         with AddGroup(rtSequence, False, False), Items do begin
    244           AddItem('if', itText, False, False);
    245           AddItem('condition', itReference, False, False);
    246           AddItem('then', itText, False, False);
    247           AddItem('statement', itReference, False, False);
    248         end;
    249         with AddGroup(rtSequence, False, False), Items do begin
    250           AddItem('whilef', itText, False, False);
    251           AddItem('condition', itReference, False, False);
    252           AddItem('do', itText, False, False);
    253           AddItem('statement', itReference, False, False);
    254         end;
    255         with AddGroup(rtSequence, False, False), Items do begin
    256           AddItem('return', itText, False, False);
    257           AddItem('expression', itReference, False, False);
    258         end;
    259         with AddGroup(rtSequence, False, False), Items do begin
    260           AddItem('write', itText, False, False);
    261           AddItem('expression', itReference, False, False);
    262         end;
    263       end;
    264     end;
    265     with AddRule('condition', rtAlternative) do begin
    266       with AddGroup(rtSequence, False, False), Items do begin
    267         AddItem('odd', itText, False, False);
    268         AddItem('expression', itReference, False, False);
    269       end;
    270       with AddGroup(rtSequence, False, False), Items do begin
    271         AddItem('expression', itReference, False, False);
    272         with AddGroup(rtAlternative, False, False), Items do begin
    273           AddItem('=', itText, False, False);
    274           AddItem('<>', itText, False, False);
    275           AddItem('<', itText, False, False);
    276           AddItem('<=', itText, False, False);
    277           AddItem('>', itText, False, False);
    278           AddItem('=>', itText, False, False);
    279         end;
    280         AddItem('expression', itReference, False, False);
    281       end;
    282     end;
    283 
    284     (*
    285           condition = ODD expression
    286              | expression ( '=' | '<>' | '<' | '<=' | '>' | '>=' ) expression .
    287              *)
    288   end;
    289 end;
    290 
    291203end.
    292204
Note: See TracChangeset for help on using the changeset viewer.