source: tools/Grammer/UGrammer.pas

unit UGrammer;

{$mode Delphi}{$H+}

interface

uses
  Classes, SysUtils, Contnrs;

type
  TRuleType = (rtSequence, rtAlternative);
  TItemType = (itReference, itText, itGroup);

  TGrammerRule = class;

  { TGrammerRuleItem }

  TGrammerRuleItem = class
    Rule: TGrammerRule;
    ItemType: TItemType;
    Text: string;
    Optional: Boolean;
    Repetition: Boolean;
    Group: TGrammerRule;
    constructor Create;
    destructor Destroy; override;
  end;

  { TGrammerRuleItems }

  TGrammerRuleItems = class(TObjectList)
    function AddNew: TGrammerRuleItem;
  end;

  { TGrammerRule }

  TGrammerRule = class
    Name: string;
    RuleType: TRuleType;
    Items: TGrammerRuleItems;
    function AddItem(AText: string; AItemType: TItemType; AOptional, ARepetition: Boolean): TGrammerRuleItem;
    function AddGroup(ARuleType: TRuleType; AOptional, ARepetition: Boolean): TGrammerRule;
    constructor Create;
    destructor Destroy; override;
  end;

  { TGrammerRules }

  TGrammerRules = class(TObjectList)
    function AddNew: TGrammerRule;
    function ItemByName(Name: string): TGrammerRule;
  end;

  TGrammer = class
    Rules: TGrammerRules;
    TopRule: TGrammerRule;
    constructor Create;
    destructor Destroy; override;
    function AddRule(AName: string; ARuleType: TRuleType): TGrammerRule;
  end;

implementation

constructor TGrammerRuleItem.Create;
begin
  Group := TGrammerRule.Create;
end;

destructor TGrammerRuleItem.Destroy;
begin
  Group.Free;
  inherited Destroy;
end;

{ TGrammerRuleItems }

function TGrammerRuleItems.AddNew: TGrammerRuleItem;
begin
  Result := TGrammerRuleItem(Items[Add(TGrammerRuleItem.Create)]);
end;

{ TGrammerRules }

function TGrammerRules.AddNew: TGrammerRule;
begin
  Result := TGrammerRule(Items[Add(TGrammerRule.Create)]);
end;

function TGrammerRules.ItemByName(Name: string): TGrammerRule;
var
  I: Integer;
begin
  I := 0;
  while (I < Count) and (TGrammerRule(Items[I]).Name <> Name) do Inc(I);
  if I < Count then Result := TGrammerRule(Items[I])
    else Result := nil;
end;

constructor TGrammer.Create;
begin
  Rules := TGrammerRules.Create;
end;

destructor TGrammer.Destroy;
begin
  Rules.Free;
  inherited Destroy;
end;

function TGrammer.AddRule(AName: string; ARuleType: TRuleType
  ): TGrammerRule;
begin
  Result := Rules.AddNew;
  with Result do begin
    Name := AName;
    RuleType := ARuleType;
  end;
end;

{ TGrammerRule }

constructor TGrammerRule.Create;
begin
  Items := TGrammerRuleItems.Create;
end;

destructor TGrammerRule.Destroy;
begin
  Items.Free;
  inherited Destroy;
end;

function TGrammerRule.AddItem(AText: string; AItemType: TItemType;
  AOptional, ARepetition: Boolean): TGrammerRuleItem;
begin
  Result := Items.AddNew;
  with Result do begin
    Text := AText;
    ItemType := AItemType;
    Optional := AOptional;
    Repetition := ARepetition;
  end;
end;

function TGrammerRule.AddGroup(ARuleType: TRuleType; AOptional,
  ARepetition: Boolean): TGrammerRule;
begin
  with Items.AddNew do begin
    Optional := AOptional;
    Repetition := ARepetition;
    ItemType := itGroup;
    Group.RuleType := ARuleType;
    Result := Group;
  end;
end;

end.