source: branches/Analyzátor gramatiky/UProgram.pas

unit UProgram;

{$MODE Delphi}

interface

uses
  Classes, ComCtrls, SysUtils, UGrammer, fgl;

type
  TProgramItem = class;

  TProgramItemList = specialize TFPGObjectList<TProgramItem>;

  TProgramItem = class
  public
    RuleBefore: TGrammerRule;
    Items: TProgramItemList;
    ItemType: TRuleItemType;
    Rule: TGrammerRule;
    Value: string;
    procedure Delete;
    procedure DeleteItem(Index: Integer);
    procedure DeleteNonterminal(ARule: TGrammerRule);
    procedure DeleteEmpty;
    procedure MergeNonterminal(ARule: TGrammerRule);
    procedure Join(ARule: TGrammerRule; ItemIndex: Integer);
    function MergeToTerminal: string;
    constructor Create;
    destructor Destroy; override;
    procedure Assign(Source: TProgramItem);
  end;

  TProgram = class
  public
    TopItem: TProgramItem;
    constructor Create;
    procedure Insert(Path: TGrammerPath; Character: Char);
    procedure Parse(Grammer: TGrammer; Tokens: TStringList);
    destructor Destroy; override;
  end;

implementation

{ TProgram }

constructor TProgram.Create;
begin
  TopItem := TProgramItem.Create;
end;

destructor TProgram.Destroy;
begin
  TopItem.Free;
  inherited;
end;

procedure TProgram.Insert(Path: TGrammerPath; Character: Char);
var
  I: Integer;
  SelectedProgramItem: TProgramItem;
begin
  SelectedProgramItem := TopItem;
  for I := 0 to Path.Items.Count - 1 do
  with Path.Items[I] do begin
    SelectedProgramItem.ItemType := itNonterminal;
    if not Assigned(SelectedProgramItem.Rule) then SelectedProgramItem.Rule := Rule;
    if SelectedProgramItem.Rule = Rule then begin
//      if (Rule.RuleType = rtSequence) or (SelectedProgramItem.Rule = SelectedProgramItem.RuleBefore) then begin
        if SelectedProgramItem.Items.Count < (CharIndex + 1) then
          SelectedProgramItem.Items.Count := CharIndex + 1;
        if not Assigned(SelectedProgramItem.Items[CharIndex]) then
          SelectedProgramItem.Items[CharIndex] := TProgramItem.Create;
        SelectedProgramItem := SelectedProgramItem.Items[CharIndex];
(*      end else begin
        SelectedProgramItem.Items.Count := SelectedProgramItem.Items.Count + 1;
        if not Assigned(SelectedProgramItem.Items[SelectedProgramItem.Items.Count - 1]) then
          SelectedProgramItem.Items[SelectedProgramItem.Items.Count - 1] := TProgramItem.Create;
        SelectedProgramItem := TProgramItem(SelectedProgramItem.Items[SelectedProgramItem.Items.Count - 1]);
      end;
*)
    end;
  end;
  with SelectedProgramItem do begin
    ItemType := itTerminal;
    Value := Character;
  end;
end;

procedure TProgram.Parse(Grammer: TGrammer; Tokens: TStringList);
var
  Path: TGrammerPath;
  I, II: Integer;
  UseIndex: Integer;
  UseCharIndex: Integer;
  UseRule: TGrammerRule;
  Level: array of Integer;
begin
  Path := TGrammerPath.Create;
  with Path.Items[Path.Items.Add(TPathItem.Create)] do begin
    Rule := Grammer.TopRule;
    ItemIndex := 0;
    CharIndex := -1;
  end;

  for I := 0 to Tokens.Count - 1 do begin
      UseIndex := Path.Items[Path.Items.Count - 1].ItemIndex;
      UseCharIndex := Path.Items[Path.Items.Count - 1].CharIndex;
      UseRule := Path.Items[Path.Items.Count - 1].Rule;
      Path.Items.Delete(Path.Items.Count - 1);
      Grammer.ClearProcessed;
      if UseRule.Check(Path, Tokens[I], UseIndex, UseCharIndex) then
      begin

      end else begin
        //raise Exception.Create('Parse error. Expected "' + Tokens[I] + '" but found "' + Text[I] + '".');
        //MainForm.StatusBar1.SimpleText := 'Parse error. Expected "' + ExpectedCharacters + '" but found "' + Text[I] + '".';
        break;
      end;
  end;
  Path.Destroy;
end;

procedure TProgramItem.MergeNonterminal(ARule: TGrammerRule);
var
  I: Integer;
begin
  for I := 0 to Items.Count - 1 do
  with Items[I] do begin
    if ItemType = itNonterminal then begin
      if Rule.Name = ARule.Name then begin
        ItemType := itTerminal;
        Value := MergeToTerminal;
      end else MergeNonterminal(ARule);
    end;
  end;
end;

{ TProgramItem }

procedure TProgramItem.Assign(Source: TProgramItem);
begin
  
end;

constructor TProgramItem.Create;
begin
  Items := TProgramItemList.Create;
end;

procedure TProgramItem.Delete;
var
  I: Integer;
begin
  for I := 0 to Items.Count - 1 do
  with Items[I] do begin
    if ItemType = itNonterminal then Delete;
  end;
end;

procedure TProgramItem.DeleteEmpty;
var
  I: Integer;
begin
  I := 0;
  while I < Items.Count do
  with Items[I] do begin
    if ItemType = itNonterminal then begin
      if Items.Count = 0 then begin
        Self.DeleteItem(I);
      end else begin
        DeleteEmpty;
        Inc(I);
      end;
    end else Inc(I);
  end;
end;

procedure TProgramItem.DeleteItem(Index: Integer);
begin
  if Items[Index].ItemType = itNonterminal then
    Items[Index].Delete;
  Items.Delete(Index);
end;

procedure TProgramItem.DeleteNonterminal(ARule: TGrammerRule);
var
  I: Integer;
begin
  I := 0;
  while I < Items.Count do
  with Items[I] do begin
    if ItemType = itNonterminal then begin
      if Rule.Name = ARule.Name then begin
        Self.DeleteItem(I);
      end else begin
        DeleteNonterminal(ARule);
        Inc(I);
      end;
    end else Inc(I);
  end;
end;

destructor TProgramItem.Destroy;
begin
  Items.Destroy;
  inherited;
end;

procedure TProgramItem.Join(ARule: TGrammerRule; ItemIndex: Integer);
var
  SubProgramItem: TProgramItem;
  I: Integer;
begin
  if (ItemType = itNonterminal) and (Rule = ARule) then begin
    SubProgramItem := Items[ItemIndex];
    RuleBefore := SubProgramItem.RuleBefore;
    Rule := SubProgramItem.Rule;
    ItemType := SubProgramItem.ItemType;
    Value := SubProgramItem.Value;
    Items[ItemIndex] := nil;
    for I := 0 to Items.Count - 1 do
      if Assigned(Items[I]) then Items[I].Free;
    Items := SubProgramItem.Items;
  end;
  for I := 0 to Items.Count - 1 do
    Items[I].Join(ARule, ItemIndex);
end;

function TProgramItem.MergeToTerminal: string;
var
  I: Integer;
begin
  Result := '';
  for I := 0 to Items.Count - 1 do
  with Items[I] do begin
    if ItemType = itTerminal then Result := Result + Value
      else Result := Result + MergeToTerminal;
  end;
end;

end.