1 | unit UMainForm;
|
---|
2 |
|
---|
3 | {$MODE Delphi}
|
---|
4 |
|
---|
5 | interface
|
---|
6 |
|
---|
7 | uses
|
---|
8 | LCLIntf, SysUtils, Classes, Graphics, Controls, Forms,
|
---|
9 | Dialogs, StdCtrls, ComCtrls, LResources, UGrammer, UProgram;
|
---|
10 |
|
---|
11 | const
|
---|
12 | DefaultGrammerFileName: string = '../../grammer/test.grm';
|
---|
13 | DefaultPascalFileName: string = '../../pascal/test.pas';
|
---|
14 |
|
---|
15 | type
|
---|
16 | TMainForm = class(TForm)
|
---|
17 | Memo1: TMemo;
|
---|
18 | Button1: TButton;
|
---|
19 | TreeView1: TTreeView;
|
---|
20 | TreeView2: TTreeView;
|
---|
21 | Button2: TButton;
|
---|
22 | Memo2: TMemo;
|
---|
23 | Button3: TButton;
|
---|
24 | StatusBar1: TStatusBar;
|
---|
25 | Button4: TButton;
|
---|
26 | procedure FormCreate(Sender: TObject);
|
---|
27 | procedure FormDestroy(Sender: TObject);
|
---|
28 | procedure Button1Click(Sender: TObject);
|
---|
29 | procedure Button2Click(Sender: TObject);
|
---|
30 | procedure Button3Click(Sender: TObject);
|
---|
31 | procedure Button4Click(Sender: TObject);
|
---|
32 | private
|
---|
33 | procedure ShowProgramNode(Node: TTreeNode; SourceProgram: TProgramItem);
|
---|
34 | public
|
---|
35 | Grammer: TGrammer;
|
---|
36 | PascalGrammer: TGrammer;
|
---|
37 | SourceProgram: TProgram;
|
---|
38 | PascalProgram: TProgram;
|
---|
39 | procedure ShowProgramTree(SourceProgram: TProgram);
|
---|
40 | procedure ShowGrammerTree(Grammer: TGrammer);
|
---|
41 | procedure ShowGrammerRule(TreeNode: TTreeNode; ARule: TGrammerRule;
|
---|
42 | Attributs: string = '');
|
---|
43 | procedure ProcessProgramTree;
|
---|
44 | function ProcessConcatenationItem(ARule: TGrammerRule; ProgramItem: TProgramItem): TGrammerItem;
|
---|
45 | function ProcessSeparationItem(var ARule: TGrammerRule; ProgramItem: TProgramItem): TGrammerItem;
|
---|
46 | end;
|
---|
47 |
|
---|
48 | var
|
---|
49 | MainForm: TMainForm;
|
---|
50 |
|
---|
51 |
|
---|
52 | implementation
|
---|
53 |
|
---|
54 | procedure TMainForm.Button1Click(Sender: TObject);
|
---|
55 | begin
|
---|
56 | SourceProgram.Free;
|
---|
57 | SourceProgram := TProgram.Create;
|
---|
58 | SourceProgram.Parse(Grammer, Memo1.Text);
|
---|
59 | ShowProgramTree(SourceProgram);
|
---|
60 | end;
|
---|
61 |
|
---|
62 | procedure TMainForm.Button2Click(Sender: TObject);
|
---|
63 | begin
|
---|
64 | ProcessProgramTree;
|
---|
65 | PascalGrammer.CorrectRuleLinks;
|
---|
66 | ShowGrammerTree(PascalGrammer);
|
---|
67 | end;
|
---|
68 |
|
---|
69 | procedure TMainForm.Button3Click(Sender: TObject);
|
---|
70 | begin
|
---|
71 | PascalProgram.Free;
|
---|
72 | PascalProgram := TProgram.Create;
|
---|
73 | PascalProgram.Parse(PascalGrammer, Memo2.Text);
|
---|
74 | with PascalProgram.TopItem, PascalGrammer do begin
|
---|
75 | // MergeNonterminal(TGrammerRule(Rules[7]));
|
---|
76 | // MergeNonterminal(TGrammerRule(Rules[9]));
|
---|
77 | // DeleteNonterminal(TGrammerRule(Rules[0]));
|
---|
78 | // DeleteEmpty;
|
---|
79 | // Join(TGrammerRule(Rules[17]), 1);
|
---|
80 | // Join(TGrammerRule(Rules[15]), 0);
|
---|
81 | // Join(TGrammerRule(Rules[14]), 0);
|
---|
82 | end;
|
---|
83 | ShowProgramTree(PascalProgram);
|
---|
84 | end;
|
---|
85 |
|
---|
86 | procedure TMainForm.Button4Click(Sender: TObject);
|
---|
87 | begin
|
---|
88 | with SourceProgram.TopItem do begin
|
---|
89 | MergeNonterminal(Grammer.Rules[7]);
|
---|
90 | MergeNonterminal(Grammer.Rules[9]);
|
---|
91 | DeleteNonterminal(Grammer.Rules[0]);
|
---|
92 | DeleteEmpty;
|
---|
93 | Join(Grammer.Rules[17], 1);
|
---|
94 | Join(Grammer.Rules[15], 0);
|
---|
95 | Join(Grammer.Rules[14], 0);
|
---|
96 | end;
|
---|
97 | ShowProgramTree(SourceProgram);
|
---|
98 | end;
|
---|
99 |
|
---|
100 | procedure TMainForm.FormCreate(Sender: TObject);
|
---|
101 | var
|
---|
102 | LowerCaseAlphabeticCharacter, UpperCaseAlphabeticCharacter,
|
---|
103 | Digit, AlphabeticCharacter, Number, AlphaNumericCharacter,
|
---|
104 | Identifier, Expression, RuleString, Rule, RuleList,
|
---|
105 | OptionBlock, RepetitionBlock, GroupingBlock,
|
---|
106 | Term, AllCharacters, WhiteSpace, Concatenation, ConcatenationBlock,
|
---|
107 | Separation, SeparationBlock, Definition: TGrammerRule;
|
---|
108 | C: Char;
|
---|
109 | I: Integer;
|
---|
110 | begin
|
---|
111 | PascalGrammer := TGrammer.Create;
|
---|
112 |
|
---|
113 | Grammer := TGrammer.Create;
|
---|
114 | with Grammer do begin
|
---|
115 | WhiteSpace := TGrammerRule.Create;
|
---|
116 | with WhiteSpace do begin
|
---|
117 | Name := 'WhiteSpace';
|
---|
118 | Token := True;
|
---|
119 | RuleType := rtAlternative;
|
---|
120 | AddTerminal(' ', False, False);
|
---|
121 | AddTerminal(#10, False, False);
|
---|
122 | AddTerminal(#13, False, False);
|
---|
123 | end;
|
---|
124 | Rules.Add(WhiteSpace);
|
---|
125 |
|
---|
126 | LowerCaseAlphabeticCharacter := TGrammerRule.Create;
|
---|
127 | with LowerCaseAlphabeticCharacter do begin
|
---|
128 | Name := 'LowerCaseAlphabeticCharacter';
|
---|
129 | RuleType := rtAlternative;
|
---|
130 | for C := 'a' to 'z' do AddTerminal(C, False, False);
|
---|
131 | end;
|
---|
132 | Rules.Add(LowerCaseAlphabeticCharacter);
|
---|
133 |
|
---|
134 | UpperCaseAlphabeticCharacter := TGrammerRule.Create;
|
---|
135 | with UpperCaseAlphabeticCharacter do begin
|
---|
136 | Name := 'UpperCaseAlphabeticCharacter';
|
---|
137 | RuleType := rtAlternative;
|
---|
138 | for C := 'A' to 'Z' do AddTerminal(C, False, False);
|
---|
139 | end;
|
---|
140 | Rules.Add(UpperCaseAlphabeticCharacter);
|
---|
141 |
|
---|
142 | AlphabeticCharacter := TGrammerRule.Create;
|
---|
143 | with AlphabeticCharacter do begin
|
---|
144 | Name := 'AlphabeticCharacter';
|
---|
145 | RuleType := rtAlternative;
|
---|
146 | AddRule(LowerCaseAlphabeticCharacter, False, False);
|
---|
147 | AddRule(UpperCaseAlphabeticCharacter, False, False);
|
---|
148 | end;
|
---|
149 | Rules.Add(AlphabeticCharacter);
|
---|
150 |
|
---|
151 | Digit := TGrammerRule.Create;
|
---|
152 | with Digit do begin
|
---|
153 | Name := 'Digit';
|
---|
154 | RuleType := rtAlternative;
|
---|
155 | for C := '0' to '9' do AddTerminal(C, False, False);
|
---|
156 | end;
|
---|
157 | Rules.Add(Digit);
|
---|
158 |
|
---|
159 | Number := TGrammerRule.Create;
|
---|
160 | with Number do begin
|
---|
161 | Name := 'Number';
|
---|
162 | Token := True;
|
---|
163 | RuleType := rtSequence;
|
---|
164 | AddTerminal('-', True, False);
|
---|
165 | AddRule(Digit, False, True);
|
---|
166 | end;
|
---|
167 | Rules.Add(Number);
|
---|
168 |
|
---|
169 | AlphaNumericCharacter := TGrammerRule.Create;
|
---|
170 | with AlphaNumericCharacter do begin
|
---|
171 | Name := 'AlphaNumericCharacter';
|
---|
172 | RuleType := rtAlternative;
|
---|
173 | AddRule(Digit, False, False);
|
---|
174 | AddRule(AlphabeticCharacter, False, False);
|
---|
175 | AddTerminal('_', False, False);
|
---|
176 | end;
|
---|
177 | Rules.Add(AlphaNumericCharacter);
|
---|
178 |
|
---|
179 | Identifier := TGrammerRule.Create;
|
---|
180 | with Identifier do begin
|
---|
181 | Name := 'Identifier';
|
---|
182 | Token := True;
|
---|
183 | RuleType := rtSequence;
|
---|
184 | AddRule(AlphabeticCharacter, False, False);
|
---|
185 | AddRule(AlphaNumericCharacter, True, True);
|
---|
186 | end;
|
---|
187 | Rules.Add(Identifier);
|
---|
188 |
|
---|
189 | AllCharacters := TGrammerRule.Create;
|
---|
190 | with AllCharacters do begin
|
---|
191 | Name := 'AllCharacters';
|
---|
192 | RuleType := rtAlternative;
|
---|
193 | for I := 32 to 38 do AddTerminal(Chr(I), False, False);
|
---|
194 | for I := 40 to 125 do AddTerminal(Chr(I), False, False);
|
---|
195 | end;
|
---|
196 | Rules.Add(AllCharacters);
|
---|
197 |
|
---|
198 | RuleString := TGrammerRule.Create;
|
---|
199 | with RuleString do begin
|
---|
200 | Name := 'String';
|
---|
201 | Token := True;
|
---|
202 | RuleType := rtSequence;
|
---|
203 | AddTerminal('''', False, False);
|
---|
204 | AddRule(AllCharacters, True, True);
|
---|
205 | AddTerminal('''', False, False);
|
---|
206 | end;
|
---|
207 | Rules.Add(RuleString);
|
---|
208 |
|
---|
209 | Concatenation := TGrammerRule.Create;
|
---|
210 | Separation := TGrammerRule.Create;
|
---|
211 |
|
---|
212 | OptionBlock := TGrammerRule.Create;
|
---|
213 | with OptionBlock do begin
|
---|
214 | Name := 'OptionBlock';
|
---|
215 | RuleType := rtSequence;
|
---|
216 | AddTerminal('[', False, False);
|
---|
217 | AddRule(WhiteSpace, True, True);
|
---|
218 | AddRule(Separation, False, False);
|
---|
219 | AddRule(WhiteSpace, True, True);
|
---|
220 | AddTerminal(']', False, False);
|
---|
221 | end;
|
---|
222 | Rules.Add(OptionBlock);
|
---|
223 |
|
---|
224 | RepetitionBlock := TGrammerRule.Create;
|
---|
225 | with RepetitionBlock do begin
|
---|
226 | Name := 'RepetitionBlock';
|
---|
227 | RuleType := rtSequence;
|
---|
228 | AddTerminal('{', False, False);
|
---|
229 | AddRule(WhiteSpace, True, True);
|
---|
230 | AddRule(Separation, False, False);
|
---|
231 | AddRule(WhiteSpace, True, True);
|
---|
232 | AddTerminal('}', False, False);
|
---|
233 | end;
|
---|
234 | Rules.Add(RepetitionBlock);
|
---|
235 |
|
---|
236 | GroupingBlock := TGrammerRule.Create;
|
---|
237 | with GroupingBlock do begin
|
---|
238 | Name := 'GroupingBlock';
|
---|
239 | RuleType := rtSequence;
|
---|
240 | AddTerminal('(', False, False);
|
---|
241 | AddRule(WhiteSpace, True, True);
|
---|
242 | AddRule(Separation, False, False);
|
---|
243 | AddRule(WhiteSpace, True, True);
|
---|
244 | AddTerminal(')', False, False);
|
---|
245 | end;
|
---|
246 | Rules.Add(GroupingBlock);
|
---|
247 |
|
---|
248 | Term := TGrammerRule.Create;
|
---|
249 | with Term do begin
|
---|
250 | Name := 'Term';
|
---|
251 | RuleType := rtAlternative;
|
---|
252 | AddRule(Identifier, False, False);
|
---|
253 | AddRule(RuleString, False, False);
|
---|
254 | end;
|
---|
255 | Rules.Add(Term);
|
---|
256 |
|
---|
257 | Expression := TGrammerRule.Create;
|
---|
258 | with Expression do begin
|
---|
259 | Name := 'Expression';
|
---|
260 | RuleType := rtAlternative;
|
---|
261 | AddRule(RepetitionBlock, False, False);
|
---|
262 | AddRule(OptionBlock, False, False);
|
---|
263 | AddRule(GroupingBlock, False, False);
|
---|
264 | AddRule(Term, False, False);
|
---|
265 | end;
|
---|
266 | Rules.Add(Expression);
|
---|
267 |
|
---|
268 | ConcatenationBlock := TGrammerRule.Create;
|
---|
269 | with ConcatenationBlock do begin
|
---|
270 | Name := 'ConcatenationBlock';
|
---|
271 | RuleType := rtSequence;
|
---|
272 | AddRule(Expression, False, False);
|
---|
273 | AddRule(WhiteSpace, True, True);
|
---|
274 | end;
|
---|
275 | Rules.Add(ConcatenationBlock);
|
---|
276 |
|
---|
277 | with Concatenation do begin
|
---|
278 | Name := 'Concatenation';
|
---|
279 | RuleType := rtSequence;
|
---|
280 | AddRule(Expression, False, False);
|
---|
281 | AddRule(WhiteSpace, True, True);
|
---|
282 | AddRule(ConcatenationBlock, True, True);
|
---|
283 | end;
|
---|
284 | Rules.Add(Concatenation);
|
---|
285 |
|
---|
286 | SeparationBlock := TGrammerRule.Create;
|
---|
287 | with SeparationBlock do begin
|
---|
288 | Name := 'SeparationBlock';
|
---|
289 | RuleType := rtSequence;
|
---|
290 | //AddRule(WhiteSpace, True, True);
|
---|
291 | AddTerminal('|', False, False);
|
---|
292 | AddRule(WhiteSpace, True, True);
|
---|
293 | AddRule(Concatenation, False, False);
|
---|
294 | end;
|
---|
295 | Rules.Add(SeparationBlock);
|
---|
296 |
|
---|
297 | with Separation do begin
|
---|
298 | Name := 'Separation';
|
---|
299 | RuleType := rtSequence;
|
---|
300 | AddRule(Concatenation, False, False);
|
---|
301 | //AddRule(WhiteSpace, True, True);
|
---|
302 | AddRule(SeparationBlock, True, True);
|
---|
303 | end;
|
---|
304 | Rules.Add(Separation);
|
---|
305 |
|
---|
306 | Rule := TGrammerRule.Create;
|
---|
307 | with Rule do begin
|
---|
308 | Name := 'Rule';
|
---|
309 | RuleType := rtSequence;
|
---|
310 | AddRule(WhiteSpace, True, True);
|
---|
311 | AddRule(Identifier, False, False);
|
---|
312 | AddRule(WhiteSpace, True, True);
|
---|
313 | AddTerminal('=', False, False);
|
---|
314 | AddRule(WhiteSpace, True, True);
|
---|
315 | AddRule(Separation, False, False);
|
---|
316 | //AddRule(WhiteSpace, True, True);
|
---|
317 | AddTerminal('.', False, False);
|
---|
318 | AddRule(WhiteSpace, True, True);
|
---|
319 | end;
|
---|
320 | Rules.Add(Rule);
|
---|
321 |
|
---|
322 | RuleList := TGrammerRule.Create;
|
---|
323 | with RuleList do begin
|
---|
324 | Name := 'RuleList';
|
---|
325 | RuleType := rtSequence;
|
---|
326 | AddRule(Rule, False, True);
|
---|
327 | end;
|
---|
328 | Rules.Add(RuleList);
|
---|
329 |
|
---|
330 | Definition := TGrammerRule.Create;
|
---|
331 | with Definition do begin
|
---|
332 | Name := 'Definition';
|
---|
333 | RuleType := rtSequence;
|
---|
334 | AddRule(RuleList, False, False);
|
---|
335 | AddRule(WhiteSpace, True, True);
|
---|
336 | AddTerminal('.', False, False);
|
---|
337 | end;
|
---|
338 | Rules.Add(Definition);
|
---|
339 |
|
---|
340 | TopRule := Definition;
|
---|
341 | end;
|
---|
342 |
|
---|
343 | ShowGrammerTree(Grammer);
|
---|
344 |
|
---|
345 | SourceProgram := TProgram.Create;
|
---|
346 | Memo1.Lines.LoadFromFile(DefaultGrammerFileName);
|
---|
347 | Memo2.Lines.LoadFromFile(DefaultPascalFileName);
|
---|
348 | // with Memo1.Lines do
|
---|
349 | // for I := 1 to Length(Text) do begin
|
---|
350 | // if (Text[I] <> ' ') and (Text[I] <> #10) and (Text[I] <> #13) then SourceCode := SourceCode + Text[I];
|
---|
351 | // end;
|
---|
352 |
|
---|
353 | //Grammer.Parse(Memo1.Text, SourceProgram);
|
---|
354 | //ShowProgramTree(SourceProgram);
|
---|
355 | end;
|
---|
356 |
|
---|
357 | procedure TMainForm.FormDestroy(Sender: TObject);
|
---|
358 | begin
|
---|
359 | Memo1.Lines.SaveToFile(DefaultGrammerFileName);
|
---|
360 | Memo2.Lines.SaveToFile(DefaultPascalFileName);
|
---|
361 | PascalGrammer.Free;
|
---|
362 | Grammer.Free;
|
---|
363 | SourceProgram.Free;
|
---|
364 | end;
|
---|
365 |
|
---|
366 | function TMainForm.ProcessConcatenationItem(ARule: TGrammerRule; ProgramItem: TProgramItem): TGrammerItem;
|
---|
367 | var
|
---|
368 | II: Integer;
|
---|
369 | NewRule: TGrammerRule;
|
---|
370 | RuleItem: TGrammerItem;
|
---|
371 | begin
|
---|
372 | with ProgramItem do begin
|
---|
373 | ARule.RuleType := rtSequence;
|
---|
374 | for II := 0 to Items.Count - 1 do begin
|
---|
375 | RuleItem := ARule.Add;
|
---|
376 | if TProgramItem(Items[II]).Rule.Name = 'Term' then begin
|
---|
377 | RuleItem.ItemType := itNonterminal;
|
---|
378 | with TProgramItem(TProgramItem(Items[II]).Items[0]) do
|
---|
379 | if (Value[1] >= 'a') and (Value[1] <= 'z') then begin
|
---|
380 | RuleItem.ItemType := itNonterminal;
|
---|
381 | RuleItem.RuleName := Value;
|
---|
382 | RuleItem.Rule := nil;
|
---|
383 | end else if Value = 'NAME' then begin
|
---|
384 | RuleItem.Rule := TGrammerRule(PascalGrammer.Rules[7]);
|
---|
385 | end else if Value = 'NUMBER' then begin
|
---|
386 | RuleItem.Rule := TGrammerRule(PascalGrammer.Rules[5]);
|
---|
387 | end else if (Length(Value) > 1) and (Value[1] = '''') and
|
---|
388 | (Value[Length(Value)] = '''') then begin
|
---|
389 | if Length(Value) > 3 then begin
|
---|
390 | NewRule := TGrammerRule.Create;
|
---|
391 | NewRule.Parent := ARule;
|
---|
392 | NewRule.Name := 'Term';
|
---|
393 | NewRule.AddTerminalText(Copy(Value, 2, Length(Value) - 2));
|
---|
394 | PascalGrammer.Rules.Add(NewRule);
|
---|
395 | RuleItem.Rule := NewRule;
|
---|
396 | RuleItem.ItemType := itNonterminal;
|
---|
397 | end else if Length(Value) = 3 then begin
|
---|
398 | RuleItem.ItemType := itTerminal;
|
---|
399 | RuleItem.Character := Value[2]
|
---|
400 | end;
|
---|
401 | end else begin
|
---|
402 | NewRule := TGrammerRule.Create;
|
---|
403 | NewRule.PArent := ARule;
|
---|
404 | NewRule.Name := 'Term';
|
---|
405 | NewRule.AddTerminalText(Value);
|
---|
406 | PascalGrammer.Rules.Add(NewRule);
|
---|
407 | RuleItem.Rule := NewRule;
|
---|
408 | RuleItem.ItemType := itNonterminal;
|
---|
409 | end;
|
---|
410 | end else if TProgramItem(Items[II]).Rule.Name = 'GroupingBlock' then begin
|
---|
411 | NewRule := TGrammerRule.Create;
|
---|
412 | NewRule.Parent := ARule;
|
---|
413 | NewRule.RuleType := rtSequence;
|
---|
414 | NewRule.Name := 'Group';
|
---|
415 | ProcessSeparationItem(NewRule, Items[II].Items[1]);
|
---|
416 | PascalGrammer.Rules.Add(NewRule);
|
---|
417 | RuleItem.ItemType := itNonterminal;
|
---|
418 | RuleItem.Rule := NewRule;
|
---|
419 | end else if TProgramItem(Items[II]).Rule.Name = 'OptionBlock' then begin
|
---|
420 | NewRule := TGrammerRule.Create;
|
---|
421 | NewRule.Parent := ARule;
|
---|
422 | NewRule.RuleType := rtSequence;
|
---|
423 | NewRule.Name := 'Option';
|
---|
424 | ProcessSeparationItem(NewRule, Items[II].Items[1]);
|
---|
425 | PascalGrammer.Rules.Add(NewRule);
|
---|
426 | RuleItem.ItemType := itNonterminal;
|
---|
427 | RuleItem.Optional := True;
|
---|
428 | RuleItem.Rule := NewRule;
|
---|
429 | end else if Items[II].Rule.Name = 'RepetitionBlock' then begin
|
---|
430 | NewRule := TGrammerRule.Create;
|
---|
431 | NewRule.Parent := ARule;
|
---|
432 | NewRule.RuleType := rtSequence;
|
---|
433 | NewRule.Name := 'Repetition';
|
---|
434 | ProcessSeparationItem(NewRule, Items[II].Items[1]);
|
---|
435 | PascalGrammer.Rules.Add(NewRule);
|
---|
436 | RuleItem.Repetition := True;
|
---|
437 | RuleItem.Optional := True;
|
---|
438 | RuleItem.ItemType := itNonterminal;
|
---|
439 | RuleItem.Rule := NewRule;
|
---|
440 | end;
|
---|
441 | end;
|
---|
442 | end;
|
---|
443 | end;
|
---|
444 |
|
---|
445 | procedure TMainForm.ProcessProgramTree;
|
---|
446 | var
|
---|
447 | I: Integer;
|
---|
448 | NewRule: TGrammerRule;
|
---|
449 | WhiteSpace, LowerCaseAlphabeticCharacter, UpperCaseAlphabeticCharacter,
|
---|
450 | AlphabeticCharacter, Digit, Number, AlphaNumericCharacter,
|
---|
451 | Identifier: TGrammerRule;
|
---|
452 | C: Char;
|
---|
453 | begin
|
---|
454 | for I := 0 to PascalGrammer.Rules.Count - 1 do
|
---|
455 | PascalGrammer.Rules[I].Free;
|
---|
456 | PascalGrammer.Rules.Clear;
|
---|
457 | with PascalGrammer do begin
|
---|
458 | WhiteSpace := TGrammerRule.Create;
|
---|
459 | with WhiteSpace do begin
|
---|
460 | Name := 'WhiteSpace';
|
---|
461 | RuleType := rtAlternative;
|
---|
462 | AddTerminal(' ', False, False);
|
---|
463 | AddTerminal(#10, False, False);
|
---|
464 | AddTerminal(#13, False, False);
|
---|
465 | end;
|
---|
466 | Rules.Add(WhiteSpace);
|
---|
467 |
|
---|
468 | LowerCaseAlphabeticCharacter := TGrammerRule.Create;
|
---|
469 | with LowerCaseAlphabeticCharacter do begin
|
---|
470 | Name := 'LowerCaseAlphabeticCharacter';
|
---|
471 | RuleType := rtAlternative;
|
---|
472 | for C := 'a' to 'z' do AddTerminal(C, False, False);
|
---|
473 | end;
|
---|
474 | Rules.Add(LowerCaseAlphabeticCharacter);
|
---|
475 |
|
---|
476 | UpperCaseAlphabeticCharacter := TGrammerRule.Create;
|
---|
477 | with UpperCaseAlphabeticCharacter do begin
|
---|
478 | Name := 'UpperCaseAlphabeticCharacter';
|
---|
479 | RuleType := rtAlternative;
|
---|
480 | for C := 'A' to 'Z' do AddTerminal(C, False, False);
|
---|
481 | end;
|
---|
482 | Rules.Add(UpperCaseAlphabeticCharacter);
|
---|
483 |
|
---|
484 | AlphabeticCharacter := TGrammerRule.Create;
|
---|
485 | with AlphabeticCharacter do begin
|
---|
486 | Name := 'AlphabeticCharacter';
|
---|
487 | RuleType := rtAlternative;
|
---|
488 | AddRule(LowerCaseAlphabeticCharacter, False, False);
|
---|
489 | AddRule(UpperCaseAlphabeticCharacter, False, False);
|
---|
490 | end;
|
---|
491 | Rules.Add(AlphabeticCharacter);
|
---|
492 |
|
---|
493 | Digit := TGrammerRule.Create;
|
---|
494 | with Digit do begin
|
---|
495 | Name := 'Digit';
|
---|
496 | RuleType := rtAlternative;
|
---|
497 | for C := '0' to '9' do AddTerminal(C, False, False);
|
---|
498 | end;
|
---|
499 | Rules.Add(Digit);
|
---|
500 |
|
---|
501 | Number := TGrammerRule.Create;
|
---|
502 | with Number do begin
|
---|
503 | Name := 'Number';
|
---|
504 | RuleType := rtSequence;
|
---|
505 | AddTerminal('-', True, False);
|
---|
506 | AddRule(Digit, False, True);
|
---|
507 | end;
|
---|
508 | Rules.Add(Number);
|
---|
509 |
|
---|
510 | AlphaNumericCharacter := TGrammerRule.Create;
|
---|
511 | with AlphaNumericCharacter do begin
|
---|
512 | Name := 'AlphaNumericCharacter';
|
---|
513 | RuleType := rtAlternative;
|
---|
514 | AddRule(Digit, False, False);
|
---|
515 | AddRule(AlphabeticCharacter, False, False);
|
---|
516 | AddTerminal('_', False, False);
|
---|
517 | end;
|
---|
518 | Rules.Add(AlphaNumericCharacter);
|
---|
519 |
|
---|
520 | Identifier := TGrammerRule.Create;
|
---|
521 | with Identifier do begin
|
---|
522 | Name := 'Identifier';
|
---|
523 | RuleType := rtSequence;
|
---|
524 | AddRule(AlphabeticCharacter, False, False);
|
---|
525 | AddRule(AlphaNumericCharacter, True, True);
|
---|
526 | end;
|
---|
527 | Rules.Add(Identifier);
|
---|
528 | end;
|
---|
529 |
|
---|
530 | PascalGrammer.TopRule := nil;
|
---|
531 | with SourceProgram.TopItem do begin
|
---|
532 | with Items[0] do begin
|
---|
533 | for I := 0 to Items.Count - 1 do with Items[I] do begin
|
---|
534 | NewRule := TGrammerRule.Create;
|
---|
535 | with PascalGrammer do
|
---|
536 | if TopRule = nil then TopRule := NewRule;
|
---|
537 | NewRule.Name := Items[0].Value;
|
---|
538 | ProcessSeparationItem(NewRule, Items[2]);
|
---|
539 | PascalGrammer.Rules.Add(NewRule);
|
---|
540 | end;
|
---|
541 | end;
|
---|
542 | end;
|
---|
543 | end;
|
---|
544 |
|
---|
545 | function TMainForm.ProcessSeparationItem(var ARule: TGrammerRule;
|
---|
546 | ProgramItem: TProgramItem): TGrammerItem;
|
---|
547 | var
|
---|
548 | II: Integer;
|
---|
549 | NewSubRule: TGrammerRule;
|
---|
550 | RuleItem: TGrammerItem;
|
---|
551 | begin
|
---|
552 | with ProgramItem do
|
---|
553 | if Items.Count > 1 then begin
|
---|
554 | ARule.RuleType := rtAlternative;
|
---|
555 | for II := 0 to Items.Count - 1 do begin
|
---|
556 | NewSubRule := TGrammerRule.Create;
|
---|
557 | NewSubRule.Parent := ARule;
|
---|
558 | NewSubRule.Name := ARule.Name;
|
---|
559 | RuleItem := ARule.Add;
|
---|
560 | RuleItem.ItemType := itNonterminal;
|
---|
561 | RuleItem.Rule := NewSubRule;
|
---|
562 | ProcessConcatenationItem(NewSubRule, Items[II]);
|
---|
563 | PascalGrammer.Rules.Add(NewSubRule);
|
---|
564 | end;
|
---|
565 | end else begin
|
---|
566 | ProcessConcatenationItem(ARule, Items[0]);
|
---|
567 | end;
|
---|
568 | end;
|
---|
569 |
|
---|
570 | procedure TMainForm.ShowGrammerRule(TreeNode: TTreeNode; ARule: TGrammerRule;
|
---|
571 | Attributs: string = '');
|
---|
572 | var
|
---|
573 | II: Integer;
|
---|
574 | NewTreeNode: TTreeNode;
|
---|
575 | // NewNode: TTreeNode;
|
---|
576 | begin
|
---|
577 | with TreeView2, Items, ARule do begin
|
---|
578 | case RuleType of
|
---|
579 | rtSequence: Attributs := Attributs + '(Seq)';
|
---|
580 | rtAlternative: Attributs := Attributs + '(Alt)';
|
---|
581 | end;
|
---|
582 | NewTreeNode := AddChild(TreeNode, ARule.Name + Attributs);
|
---|
583 | for II := 0 to Items.Count - 1 do
|
---|
584 | with Items[II] do begin
|
---|
585 | if Optional then Attributs := '(Opt)' else Attributs := '';
|
---|
586 | if Repetition then Attributs := Attributs + '(Rep)';
|
---|
587 | case ItemType of
|
---|
588 | itTerminal: begin
|
---|
589 | Attributs := Character + Attributs;
|
---|
590 | AddChild(NewTreeNode, Attributs);
|
---|
591 | end;
|
---|
592 | itNonterminal: begin
|
---|
593 | if Assigned(Rule) then begin
|
---|
594 | if Rule.Parent = ARule then
|
---|
595 | ShowGrammerRule(NewTreeNode, Rule, Attributs)
|
---|
596 | else AddChild(NewTreeNode, '<' + Rule.Name + '>' + Attributs);
|
---|
597 | end else AddChild(NewTreeNode, '<?>' + Attributs);
|
---|
598 | end;
|
---|
599 | end;
|
---|
600 | end;
|
---|
601 | end;
|
---|
602 | end;
|
---|
603 |
|
---|
604 | procedure TMainForm.ShowGrammerTree(Grammer: TGrammer);
|
---|
605 | var
|
---|
606 | I: Integer;
|
---|
607 | begin
|
---|
608 | with Grammer, TreeView2, Items do begin
|
---|
609 | BeginUpdate;
|
---|
610 | Clear;
|
---|
611 | TopItem := AddChild(nil, 'Gramatika');
|
---|
612 | for I := 0 to Rules.Count - 1 do with TGrammerRule(Rules[I]) do
|
---|
613 | if not Assigned(Parent) then ShowGrammerRule(TopItem, TGrammerRule(Rules[I]));
|
---|
614 | TopItem.Expand(False);
|
---|
615 | EndUpdate;
|
---|
616 | end;
|
---|
617 | end;
|
---|
618 |
|
---|
619 | procedure TMainForm.ShowProgramNode(Node: TTreeNode; SourceProgram: TProgramItem);
|
---|
620 | var
|
---|
621 | TreeNode: TTreeNode;
|
---|
622 | I: Integer;
|
---|
623 | begin
|
---|
624 | if SourceProgram.ItemType = itNonterminal then begin
|
---|
625 | TreeNode := TreeView1.Items.AddChild(Node, SourceProgram.Rule.Name);
|
---|
626 | for I := 0 to SourceProgram.Items.Count - 1 do
|
---|
627 | if Assigned(SourceProgram.Items[I]) then
|
---|
628 | //TreeView1.Items.AddChild(TreeNode, IntToStr(I))
|
---|
629 | ShowProgramNode(TreeNode, SourceProgram.Items[I])
|
---|
630 | else TreeView1.Items.AddChild(TreeNode, 'x');
|
---|
631 | end else begin
|
---|
632 | TreeView1.Items.AddChild(Node, SourceProgram.Value);
|
---|
633 | end;
|
---|
634 | end;
|
---|
635 |
|
---|
636 | procedure TMainForm.ShowProgramTree(SourceProgram: TProgram);
|
---|
637 | begin
|
---|
638 | with TreeView1, Items do begin
|
---|
639 | BeginUpdate;
|
---|
640 | Clear;
|
---|
641 | TopItem := AddChild(nil, 'Program');
|
---|
642 | ShowProgramNode(TopItem, SourceProgram.TopItem);
|
---|
643 | TopItem.Expand(True);
|
---|
644 | EndUpdate;
|
---|
645 | end;
|
---|
646 | end;
|
---|
647 |
|
---|
648 | initialization
|
---|
649 | {$i UMainForm.lrs}
|
---|
650 |
|
---|
651 | end.
|
---|