source: branches/Void/UGrammer.pas

unit UGrammer;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, fgl, UTokenizer;

type
  TRuleType = (rtSequence, rtAlternative);
  TRuleItemType = (itTerminal, itNonterminal);

  TGrammerRule = class;
  TGrammer = class;

  THandleEvent = procedure (GrammerRule: TGrammerRule) of object;

  TGrammerItem = class
  private
    Parent: TGrammerRule;
  public
    TokenType: TTokenType;
    Rule: TGrammerRule;
    ItemType: TRuleItemType;
    Optional: Boolean;
    Repetition: Boolean;
    Text: string;
  end;

  TGrammerItemList = specialize TFPGObjectList<TGrammerItem>;

  { TGrammerRule }

  TGrammerRule = class
  private
    FOnHandle: THandleEvent;
    Parent: TGrammer;
  public
    Name: string;
    RuleType: TRuleType;
    Items: TGrammerItemList;
    procedure AddTerminal(AText: string; ATokenType: TTokenType; AOptional, ARepetition: Boolean);
    procedure AddRule(ARule: TGrammerRule; AOptional, ARepetition: Boolean);
    constructor Create;
    destructor Destroy; override;
    property OnHandle: THandleEvent read FOnHandle write FOnHandle;
  end;

  TGrammerRuleList = specialize TFPGObjectList<TGrammerRule>;

  TGrammer = class
    Rules: TGrammerRuleList;
    TopRule: TGrammerRule;
    constructor Create;
    destructor Destroy; override;
  end;

implementation

procedure TGrammerRule.AddTerminal(AText: string; ATokenType: TTokenType; AOptional, ARepetition: Boolean
  );
begin
  with Items[Items.Add(TGrammerItem.Create)] do begin
    ItemType := itTerminal;
    TokenType := ATokenType;
    Text := AText;
    Optional := AOptional;
    Repetition := ARepetition;
    Parent := Self;
  end;
end;

procedure TGrammerRule.AddRule(ARule: TGrammerRule; AOptional,
  ARepetition: Boolean);
begin
  with Items[Items.Add(TGrammerItem.Create)] do begin
    ItemType := itNonterminal;
    Rule := ARule;
    Optional := AOptional;
    Repetition := ARepetition;
    Parent := Self;
  end;
end;

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

destructor TGrammerRule.Destroy;
begin
  inherited Destroy;
end;

{ TGrammer }

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

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

end.