Changeset 17
- Timestamp:
- Apr 9, 2009, 11:16:15 AM (16 years ago)
- Location:
- branches
- Files:
-
- 4 added
- 1 deleted
- 5 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/Analyzátor gramatiky
-
Property svn:ignore
set to
*.exe
*.dcu
-
Property svn:ignore
set to
-
branches/Analyzátor gramatiky/PascalCompiler.dpr
r10 r17 6 6 Forms, 7 7 UMainForm in 'UMainForm.pas' {MainForm}, 8 UGrammer in 'UGrammer.pas'; 8 UGrammer in 'UGrammer.pas', 9 UProgram in 'UProgram.pas'; 9 10 10 11 {$R *.res} 11 12 12 13 begin 14 {$WARN SYMBOL_PLATFORM OFF} 15 ReportMemoryLeaksOnShutdown := DebugHook <> 0; 16 {$WARN SYMBOL_PLATFORM ON} 13 17 Application.Initialize; 14 18 Application.CreateForm(TMainForm, MainForm); -
branches/Analyzátor gramatiky/UGrammer.pas
r10 r17 4 4 5 5 uses 6 Classes, ComCtrls, SysUtils ;6 Classes, ComCtrls, SysUtils, Math, UGrammerRules; 7 7 8 8 type … … 37 37 TRuleType = (rtSequence, rtAlternative); 38 38 TRuleItemType = (itTerminal, itNonterminal); 39 40 TProgramItem = class41 public42 RuleBefore: TGrammerRule;43 Items: TList; // of TProgramItem;44 ItemType: TRuleItemType;45 Rule: TGrammerRule;46 Value: string;47 procedure Delete;48 procedure DeleteItem(Index: Integer);49 procedure DeleteNonterminal(ARule: TGrammerRule);50 procedure DeleteEmpty;51 procedure MergeNonterminal(ARule: TGrammerRule);52 procedure Join(ARule: TGrammerRule; ItemIndex: Integer);53 function MergeToTerminal: string;54 constructor Create;55 destructor Destroy; override;56 procedure Assign(Source: TProgramItem);57 end;58 59 TProgram = class60 public61 TopItem: TProgramItem;62 constructor Create;63 procedure Insert(Path: TGrammerPath; Character: Char);64 destructor Destroy; override;65 end;66 39 67 40 TGrammerItem = class … … 105 78 constructor Create; 106 79 procedure ClearProcessed; 107 procedure Parse(Text: string; var ParsedProgram: TProgram);108 80 procedure CorrectRuleLinks; 109 81 destructor Destroy; override; … … 112 84 113 85 implementation 114 115 uses116 UMainForm;117 86 118 87 { TGrammerRule } … … 289 258 Rules.Free; 290 259 inherited; 291 end;292 293 procedure TGrammer.Parse(Text: string; var ParsedProgram: TProgram);294 var295 Path: TGrammerPath;296 I, II: Integer;297 Q: Integer;298 C: Integer;299 Scope: TPossibleCharacters;300 UseIndex: Integer;301 UseCharIndex: Integer;302 UseRule: TGrammerRule;303 ExpectedCharacters: string;304 Level: array of Integer;305 LevelLength: Integer;306 LevelIsLeft: Boolean;307 begin308 SetLength(Path.Items, Length(Path.Items) + 1);309 with Path.Items[High(Path.Items)] do begin310 Rule := TopRule;311 ItemIndex := 0;312 CharIndex := -1;313 end;314 315 for I := 1 to Length(Text) do begin316 if (Text[I] <> #13) and (Text[I] <> #10) then begin317 UseIndex := Path.Items[High(Path.Items)].ItemIndex;318 UseCharIndex := Path.Items[High(Path.Items)].CharIndex;319 UseRule := Path.Items[High(Path.Items)].Rule;320 SetLength(Path.Items, Length(Path.Items) - 1);321 SetLength(Scope.Items, 0);322 ClearProcessed;323 UseRule.GetPossibleCharacters(Path, Scope, UseIndex, UseCharIndex);324 C := Length(Scope.Items);325 326 SetLength(Level, 0);327 for II := 0 to High(Scope.Items) do with Scope.Items[II] do begin328 if (Character = Text[I]) then begin329 if Length(RulePath.Items) > Length(Level) then begin330 LevelLength := Length(Level);331 SetLength(Level, Length(RulePath.Items));332 for Q := LevelLength to High(Level) do333 Level[Q] := High(Integer);334 end;335 LevelIsLeft := True;336 for Q := 0 to High(Level) do begin337 if Level[Q] > RulePath.Items[Q].ItemIndex then begin338 LevelIsLeft := False;339 Break;340 end;341 if Level[Q] < RulePath.Items[Q].ItemIndex then Break;342 end;343 if (not LevelIsLeft) or (Length(RulePath.Items) > Length(Level)) then begin344 SetLength(Level, Length(RulePath.Items));345 for Q := 0 to High(Level) do346 Level[Q] := RulePath.Items[Q].ItemIndex;347 C := II;348 end;349 end;350 end;351 352 if C < Length(Scope.Items) then begin353 Path.Assign(Scope.Items[C].RulePath);354 for II := 0 to Length(Path.Items) - 1 do with Path.Items[II] do begin355 if Affected then Inc(CharIndex);356 end;357 ParsedProgram.Insert(Path, Scope.Items[C].Character);358 for II := 0 to Length(Path.Items) - 1 do with Path.Items[II] do begin359 Affected := False;360 end;361 //Path.Next;362 end else begin363 ExpectedCharacters := '';364 for II := 0 to Length(Scope.Items) - 1 do365 ExpectedCharacters := ExpectedCharacters + Scope.Items[II].Character;366 //raise Exception.Create('Parse error. Expected "' + ExpectedCharacters + '" but found "' + Text[I] + '".');367 MainForm.StatusBar1.SimpleText := 'Parse error. Expected "' + ExpectedCharacters + '" but found "' + Text[I] + '".';368 break;369 end;370 end;371 end;372 373 end;374 375 { TProgram }376 377 constructor TProgram.Create;378 begin379 TopItem := TProgramItem.Create;380 end;381 382 destructor TProgram.Destroy;383 begin384 TopItem.Free;385 inherited;386 end;387 388 procedure TProgram.Insert(Path: TGrammerPath; Character: Char);389 var390 I: Integer;391 SelectedProgramItem: TProgramItem;392 begin393 SelectedProgramItem := TopItem;394 for I := 0 to High(Path.Items) do with Path.Items[I] do begin395 SelectedProgramItem.ItemType := itNonterminal;396 if not Assigned(SelectedProgramItem.Rule) then SelectedProgramItem.Rule := Rule;397 if SelectedProgramItem.Rule = Rule then begin398 // if (Rule.RuleType = rtSequence) or (SelectedProgramItem.Rule = SelectedProgramItem.RuleBefore) then begin399 if SelectedProgramItem.Items.Count < (CharIndex + 1) then400 SelectedProgramItem.Items.Count := CharIndex + 1;401 if not Assigned(SelectedProgramItem.Items[CharIndex]) then402 SelectedProgramItem.Items[CharIndex] := TProgramItem.Create;403 SelectedProgramItem := TProgramItem(SelectedProgramItem.Items[CharIndex]);404 (* end else begin405 SelectedProgramItem.Items.Count := SelectedProgramItem.Items.Count + 1;406 if not Assigned(SelectedProgramItem.Items[SelectedProgramItem.Items.Count - 1]) then407 SelectedProgramItem.Items[SelectedProgramItem.Items.Count - 1] := TProgramItem.Create;408 SelectedProgramItem := TProgramItem(SelectedProgramItem.Items[SelectedProgramItem.Items.Count - 1]);409 end;410 *)411 end;412 end;413 with SelectedProgramItem do begin414 ItemType := itTerminal;415 Value := Character;416 end;417 end;418 419 procedure TProgramItem.MergeNonterminal(ARule: TGrammerRule);420 var421 I: Integer;422 begin423 for I := 0 to Items.Count - 1 do with TProgramItem(Items[I]) do begin424 if ItemType = itNonterminal then begin425 if Rule.Name = ARule.Name then begin426 ItemType := itTerminal;427 Value := MergeToTerminal;428 end else MergeNonterminal(ARule);429 end;430 end;431 end;432 433 { TProgramItem }434 435 procedure TProgramItem.Assign(Source: TProgramItem);436 begin437 438 end;439 440 constructor TProgramItem.Create;441 begin442 Items := TList.Create;443 end;444 445 procedure TProgramItem.Delete;446 var447 I: Integer;448 begin449 for I := 0 to Items.Count - 1 do with TProgramItem(Items[I]) do begin450 if ItemType = itNonterminal then Delete;451 end;452 end;453 454 procedure TProgramItem.DeleteEmpty;455 var456 I: Integer;457 begin458 I := 0;459 while I < Items.Count do with TProgramItem(Items[I]) do begin460 if ItemType = itNonterminal then begin461 if Items.Count = 0 then begin462 Self.DeleteItem(I);463 end else begin464 DeleteEmpty;465 Inc(I);466 end;467 end else Inc(I);468 end;469 end;470 471 procedure TProgramItem.DeleteItem(Index: Integer);472 begin473 if TProgramItem(Items[Index]).ItemType = itNonterminal then474 TProgramItem(Items[Index]).Delete;475 Items.Delete(Index);476 end;477 478 procedure TProgramItem.DeleteNonterminal(ARule: TGrammerRule);479 var480 I: Integer;481 begin482 I := 0;483 while I < Items.Count do with TProgramItem(Items[I]) do begin484 if ItemType = itNonterminal then begin485 if Rule.Name = ARule.Name then begin486 Self.DeleteItem(I);487 end else begin488 DeleteNonterminal(ARule);489 Inc(I);490 end;491 end else Inc(I);492 end;493 end;494 495 destructor TProgramItem.Destroy;496 var497 I: Integer;498 begin499 for I := 0 to Items.Count - 1 do TProgramItem(Items[I]).Free;500 Items.Free;501 inherited;502 end;503 504 procedure TProgramItem.Join(ARule: TGrammerRule; ItemIndex: Integer);505 var506 SubProgramItem: TProgramItem;507 I: Integer;508 begin509 if (ItemType = itNonterminal) and (Rule = ARule) then begin510 SubProgramItem := TProgramItem(Items[ItemIndex]);511 RuleBefore := SubProgramItem.RuleBefore;512 Rule := SubProgramItem.Rule;513 ItemType := SubProgramItem.ItemType;514 Value := SubProgramItem.Value;515 Items[ItemIndex] := nil;516 for I := 0 to Items.Count - 1 do517 if Assigned(Items[I]) then TProgramItem(Items[I]).Free;518 Items := SubProgramItem.Items;519 end;520 for I := 0 to Items.Count - 1 do521 TProgramItem(Items[I]).Join(ARule, ItemIndex);522 end;523 524 function TProgramItem.MergeToTerminal: string;525 var526 I: Integer;527 begin528 Result := '';529 for I := 0 to Items.Count - 1 do with TProgramItem(Items[I]) do begin530 if ItemType = itTerminal then Result := Result + Value531 else Result := Result + MergeToTerminal;532 end;533 260 end; 534 261 -
branches/Analyzátor gramatiky/UMainForm.pas
r10 r17 5 5 uses 6 6 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 7 Dialogs, StdCtrls, ComCtrls, UGrammer ;7 Dialogs, StdCtrls, ComCtrls, UGrammer, UProgram; 8 8 9 9 const … … 56 56 SourceProgram.Free; 57 57 SourceProgram := TProgram.Create; 58 Grammer.Parse(Memo1.Text, SourceProgram);58 SourceProgram.Parse(Grammer, Memo1.Text); 59 59 ShowProgramTree(SourceProgram); 60 60 end; … … 71 71 PascalProgram.Free; 72 72 PascalProgram := TProgram.Create; 73 Pascal Grammer.Parse(Memo2.Text, PascalProgram);73 PascalProgram.Parse(PascalGrammer, Memo2.Text); 74 74 with PascalProgram.TopItem, PascalGrammer do begin 75 75 // MergeNonterminal(TGrammerRule(Rules[7])); … … 267 267 Name := 'ConcatenationBlock'; 268 268 RuleType := rtSequence; 269 AddRule( WhiteSpace, True, True);270 AddRule( Expression, True, False);269 AddRule(Expression, False, False); 270 AddRule(WhiteSpace, True, True); 271 271 end; 272 272 Rules.Add(ConcatenationBlock); … … 285 285 Name := 'SeparationBlock'; 286 286 RuleType := rtSequence; 287 AddRule(WhiteSpace, True, True);287 //AddRule(WhiteSpace, True, True); 288 288 AddTerminal('|', False, False); 289 289 AddRule(WhiteSpace, True, True); … … 296 296 RuleType := rtSequence; 297 297 AddRule(Concatenation, False, False); 298 AddRule(WhiteSpace, True, True);298 //AddRule(WhiteSpace, True, True); 299 299 AddRule(SeparationBlock, True, True); 300 300 end; … … 311 311 AddRule(WhiteSpace, True, True); 312 312 AddRule(Separation, False, False); 313 AddRule(WhiteSpace, True, True);313 //AddRule(WhiteSpace, True, True); 314 314 AddTerminal('.', False, False); 315 315 AddRule(WhiteSpace, True, True); -
branches/DelphiToC
- Property svn:ignore
-
old new 4 4 *.~dsk 5 5 *.dcu 6 ProjectGroup1.bdsgroup
-
- Property svn:ignore
Note:
See TracChangeset
for help on using the changeset viewer.