type adresa=^trie;
trie=record
c:char;
x,nr:longint;
f,fr:adresa;
end;
var a,x,p:adresa;
j:longint;s:string;b:boolean;c,cc:char;
procedure add;
var n:byte;
begin
x:=a;n:=length(s);
for j:=1 to n do
 begin
  if x^.f=nil then
  begin
  new(p);
  p^.f:=nil;
  p^.fr:=nil;
  p^.c:=s[j];
  p^.x:=1;
  if j=n then p^.nr:=1 else p^.nr:=0;
  x^.f:=p;x:=p;
  end else
  begin
  x:=x^.f;
   while(x^.fr<>nil)and(x^.c<>s[j]) do  x:=x^.fr;
   if x^.c=s[j] then begin inc(x^.x);if j=n then inc(x^.nr);end else
    begin
    new(p);
    p^.f:=nil;
    p^.fr:=nil;
    p^.c:=s[j];
    p^.x:=1;
    if j=n then p^.nr:=1 else p^.nr:=0;
      x^.fr:=p;x:=p;
     end;
    end;
   end;
 end;

 procedure delete;
 var n:byte;
 begin
 x:=a^.f;
 n:=length(s);b:=false;
 for j:=1 to n do
  if not b  then
  begin
  while (x^.fr<>nil)and(x^.c<>s[j]) do x:=x^.fr;
  if x^.c=s[j] then
   begin
    if x^.x>0 then
     begin
     dec(x^.x);
    if j=n then dec(x^.nr);
    x:=x^.f;
     end;
   end else b:=true;
  end;
end;
function  aparitii:longint;
var n:byte;k:longint;
begin
x:=a^.f; k:=0;
if x=nil then aparitii:=0 else
begin
n:=length(s);b:=false;
for j:=1 to n do
if not b then
begin
if x=nil then b:=true else
begin
while (x^.fr<>nil)and(x^.c<>s[j]) do x:=x^.fr;
if x^.c=s[j] then
begin
if j=n then k:=x^.nr else x:=x^.f;
end else begin b:=true; k:=0; end;
end;
end;
aparitii:=k;
end;
end;
function prefix:integer;
var n:byte;k:longint;
begin
n:=length(s);x:=a^.f;k:=0;
if x=nil then prefix:=0 else
begin
b:=false;
for j:=1 to n do
if not b then
begin
while (x^.fr<>nil)and(x^.c<>s[j]) do x:=x^.fr;
if (x^.c=s[j])and(x^.x>0) then begin k:=k+1;x:=x^.f;if x=nil then b:=true;
end else b:=true;
end;
prefix:=k;
end;
end;
begin
assign(input,'trie.in');reset(input);
assign(output,'trie.out');rewrite(output);
new(a);a^.f:=nil;a^.fr:=nil;
while not eof(input) do
begin
readln(c,cc,s);
case c of
'0': add;
'1': delete;
'2': writeln(aparitii);
'3': writeln(prefix);
end;
end;
close(input);
close(output);
end.