{Задание #2 практикума на ЭВМ}
{Подорожный Юрий. Группа 111}
program prak2(input,output);

const SZ=6; {максимальное количество букв в слове}

type mword=packed array[1..SZ] of char;
     tree=^tnode;
     tnode=record
     wrd:mword;
     nmb:integer;    {номер первого вхождения слова в последовательность}
     left,right:tree;
     end;

var tr:tree;
    cnt:integer;
    w:mword;
    ch:char;

{процедура вставки слова в дерево поиска}
procedure instree(var t:tree;x:mword;n:integer);
begin
     if t=nil then
     begin
          new(t);
          with t^ do
          begin
               wrd:=x;
               nmb:=n;
               left:=nil;
               right:=nil;
          end;
     end else
     with t^ do
     begin
          if wrd<x then instree(right,x,n)
          else if wrd>x then instree(left,x,n);
     end;
end;

{процедура печати слов, входящих в дерево}
procedure writetree(t:tree);
begin
     if t<>nil then
     begin
          if t^.left<>nil then writetree(t^.left);
          writeln(t^.wrd,' ',t^.nmb);
          if t^.right<>nil then writetree(t^.right);
     end;
end;

{освобождение памяти, занимаемой деревом}
procedure freetree(t:tree);
var l,r:tree;
begin
     if t<>nil then
     begin
          l:=t^.left;
          r:=t^.right;
          dispose(t);
          if l<>nil then freetree(l);
          if r<>nil then freetree(r);
     end;
end;

{процедура обнуления слова}
procedure wfree(var wrd:mword);
var i:integer;
begin
     for i:=1 to SZ do wrd[i]:=' ';
end;

{процедура вывода сообщения об ошибке и завершения программы}
procedure e_exit;
begin
     writeln('Некорректные входные данные.');
     halt(1);
end;

{процедура выделения слова}
procedure readword(var wrd:mword; var c:char);
var j:integer;
begin
     j:=1;
     read(c);
     if (c=',') or (c='.') then e_exit;
     while not ((c='.') or (c=',')) do
     begin
          if (not (c in ['A'..'Z'])) or (j=SZ+1) then e_exit;
          wrd[j]:=c;
          j:=j+1;
          read(c);
     end;
end;

{процедура начальной инициализации}
procedure init;
begin
     tr:=nil;
     cnt:=1;
     wfree(w);
     ch:=' ';
     writeln('Введите последовательность слов:');
end;

begin
     init;
     while ch<>'.' do
     begin
          readword(w,ch);
          instree(tr,w,cnt);
          wfree(w);
          cnt:=cnt+1;
     end;
     writetree(tr);
     freetree(tr);
     readln;
end.