1.pas

用Delphi写的Google引擎算法

列表1：搜索短语解析器类
type
  // a base node that helps form RPN string
  TaaRPNNode = class
    private
      FNext : TaaRPNNode;
    public
      destructor Destroy: override;
      procedure  Append(aNode : TaaRPNNode);
  end;
  
  TaaRPNWord = class(TaaNNode) // an RPN node for a word
    private
      FWord : string;
    public
      constructor Create(const aPhraseWord : string);
      property PhraseWord : string read FWord;
    end;
    
  // an RPN node for the AND operator
  TaaRPN_AND = class(TaaRPNNode);
  // an RPN node for the OR operator
  TaaRPN_OR = class(TaaRPNNode);
  // an RPN node for the NOT operator
  TaaRPN_NOT = class(TaaRPNNode);
    
  TaaSearchParse = class // a parser for search phrases
    private
      FCurWord : string;
      FPhrase  : string;
      FPosn    : integer;
      FRPN     : TaaRPNNode;
    protected
      function  spGetRPN : TaaRPNNode;
      procedure spSetPhrase(const aPhrase : string);
      function  spParseExpr : TaaRPNNode;
      function  spParseFactor : TaaRPNNode;
      function  spParseTerm : TaaRPNNode;
      procedure spParsePhrase;
      procedure spGetNextWord;
    public
      constructor Create(const aPhrase : string);
      destructor Destroy; override;
      property Phrase : string read FPhrase write spSetPhrase;
      property RPN : TaaRPNNode read spGetRPN;
  end;

destructor TaaRPNNode.Destroy;
begin
  Next.Free;
  inherited Destroy;
end;

procedure TaaRPNNode.Append(aNode : TaaRPNNode);
var
  Walker : TaaRPNNode;
begin
  Walker := Self;
  while (Walker.Next <> nil)do
    Walker := Walker.Next;
  Walker.FNext := aNode;
end;

constructor TaaRPNWord.Create(const aPhraseWord : string);
begin
  inherited Create;
  FWord := aPhraseWord;
end;

constructor TaaSearchParser.Create(const aPhrase : string);
begin
  inherited Create;
  Phrase := aPhrase;
end;

destructor TaaSearchParser.Destroy;
begin
  FRPN.Free;
  inherited Destroy;
end;

procedure TaaSearchParser.spGetNextWord;
var
  Walker    : PAnsiChar;
  WordStart : PAnsiChar;
begin
  inc(FPosn , length(FCurWord));
  FCurWord := '';
  Walker := @FPhrase[FPosn];
  while (Walker^ =' ') do
    begin
      inc(FPosn);
      inc(Walker);
    end;
  if (Walker^ = '(') then
    FCurWord := '('
  else if (Walker^ = '(') then
    FCurWord := '('
  else
    begin
      WordStart := Walker;
      while (Walker^ <> #0) and (Walker^ <> ' ') and (Walker^ <> '(') and (Walker^ <> ')') do
        inc(Walker);
      FCurWord := Copy(FPhrase, FPosn, Walker - WordStart);
    end;
end;

function TaaSearchParser.spGetRPN : TaaRPNNode;
begin
  if (FRPN = nil) then
    spParsePhrase;
  Result := FRPN;
end;

function TaaSearchParser.spParseExpr : TaaRPNNode;
begin
  Result := spParseFactor;
  spGetNextWord;
  if (FCurWord = 'and') then
    begin
      spGetNextWord;
      Result.Append(spParseExpr);
      Result.Append(TaaRPN_AND.Create);
    end   
  else if (FCurWord = 'or') then
    begin
      spGetNextWord;
      Result.Append(spParseExpr);
      Result.Append(TaaRPN_OR.Create);
    end
  else if (FCurWord <> '') and (FCurWord <> ')') then
    begin
      Result.Append(spParseExpr);
      Result.Append(TaaRPN_AND.Create);
    end;
end;

function TaaSearchParser.spParseFactor : TaaRPNNode;
begin
  if (FCurWord <> 'not' ) then
    Result := spParseTerm
  else
    begin
      spGetNextWord;
      Result.Append(spParseExpr);
      Result.Append(TaaRPN_NOT.Create);
    end;
end;

procedure TaaSearchParser.spParsePhrase;
begin
  if (FPhrase <> '') then
    begin
      FPosn := 1;
      spGetNextWord;
      if (FCurWord <> '') then
        FRPN := spParseExpr;
    end;
end;

function TaaSearchParser.spParseTerm : TaaRPNNode;
begin
  if (FCurWord = '(') then
    begin
      spGetNextWord;
      Result := spParseExpr;
      if (FCurWord <> ')') then
        raise Exception('TaaSearchParser : missing close parenthsis in phrase');
    end
  else
    begin
      if (FCurWord = '') then
        raise Exception.Create('TaaSearchParse : missing final search word');
      if (FCurWord = 'add') or (FCurWord = 'or') or (FCurWord = 'not' ) then
        raise Exception.Create('TaaSearchParser : operator used as search word');
      Result := TaaRPNWord.Create(FCurWord);
    end;
end;

procedure TaaSearchParser.spSetPhrase(const aPhrase : string);
begin
  FPhrase := LowerCase(aPhrase);
  FRPN.Free;
  FRPN := nil;
end;