Noi2011 阿狸的打字机

var g1,g2,g3,next,last,en,tail:array[..] of longint;
    e,q,fa,ps,pt,fail,ans:array[..] of longint;
    trie:array[..,..] of longint;
    c:array[..] of longint;
    s:array[..] of char;
    tot,size,len,len1,len2,l,r,n:longint;
//============================================================================
procedure ins(x,y:longint);
begin
  inc(len1); g1[len1]:=y;
  next[len1]:=en[x]; en[x]:=len1;
end;
//============================================================================
procedure insert(x,y,z:longint);    //本来打算对询问排序一下一起搞的。。看到网上建图的奇葩做法顿觉我弱爆了。。。
begin
  inc(len2); g2[len2]:=y; g3[len2]:=z;
  last[len2]:=tail[x]; tail[x]:=len2;
end;
//============================================================================
procedure add(x,y:longint);    //树状数组的修改操作。（添加和取消标号一起搞，加上±）
begin
  while x<=size do
  begin
    inc(c[x],y);
    inc(x,x and -x);
  end;
end;
//============================================================================
function sum(x:longint):longint;    //树状数组的求和操作。
begin sum:=;
  while x> do
  begin
    inc(sum,c[x]);
    dec(x,x and -x);
  end;
end;
//============================================================================
procedure init;
var now,tmp:longint;
    ch:char;
begin
  read(ch); tot:=; now:=; n:=;
  while ch in ['B','P','a'..'z'] do
  begin
    inc(len); s[len]:=ch;
    if ch='B' then now:=fa[now] else
    if ch='P' then
    begin
      inc(n); e[n]:=now;
    end else
    begin
      tmp:=ord(ch)-ord('a')+;
      if trie[now,tmp]<> then now:=trie[now,tmp] else    //建立trie树。
      begin
        inc(tot); trie[now,tmp]:=tot;
        fa[tot]:=now; now:=tot;
      end;
    end; read(ch);
  end;
end;
//============================================================================
procedure get_fail;    //生成失败指针。顺便反向建树。
var g,h,i,j,now:longint;
    tmp:char;
begin
  l:=; r:=; fail[]:=;
  for i:= to  do    //后来写的一个AC自动机引入一个-点貌似在求失败指针的时候更简洁。
  begin
    if trie[,i]<> then
    begin
      inc(r); q[r]:=trie[,i];
      fail[q[r]]:=; ins(,q[r]);  //建树。
    end;
  end;
  while l<=r do
  begin g:=r;
    for h:=l to g do
    begin now:=q[h];
      for i:= to  do
      begin
        if trie[now,i]<> then
        begin
          inc(r); q[r]:=trie[now,i]; j:=fail[now];
          while j<> do
            if trie[j,i]<> then
            begin
              fail[q[r]]:=trie[j,i];
              ins(trie[j,i],q[r]); break;    //建树。
            end else j:=fail[j];
          if j= then
          begin
            fail[q[r]]:=;
            ins(,q[r]);
          end;
        end;
      end;
    end; l:=g+;
  end;
end;
//============================================================================
procedure dfs(x:longint);    //求dfs序。
var i:longint;
begin
  inc(size); ps[x]:=size; i:=en[x];
  while i<> do
  begin
    dfs(g1[i]); i:=next[i];
  end;
  inc(size); pt[x]:=size;    //弹出的时候我也加入了。可以不用的貌似。
end;
//============================================================================
procedure main;
var x,y,i,j,m,now,tmp:longint;
begin
  readln(m);
  for i:= to m do
  begin
    readln(x,y);
    insert(y,x,i);    //这样就把询问分类了。OTZ...
  end;
  now:=; tmp:=;
  for i:= to len do
  begin
    if s[i]='P' then
    begin j:=tail[tmp];
      while j> do
      begin
        ans[g3[j]]:=sum(pt[e[g2[j]]])-sum(ps[e[g2[j]]]-);
        j:=last[j];
      end; inc(tmp);
    end else
    if s[i]='B' then
    begin
      add(ps[now],-);    //标记的时候只要标记在dfs序中先出现的点。（其实都一样，只要标任一个）
      now:=fa[now];
    end else
    begin
      now:=trie[now,ord(s[i])-ord('a')+];
      add(ps[now],);
    end;
  end;
  for i:= to m do writeln(ans[i]);
end;
//============================================================================
begin
  assign(input,'type.in');
  assign(output,'type.out');
  reset(input); rewrite(output);
  init;
  get_fail;
  dfs();
  main;
  close(input); close(output);
end.