Type
  point = ^MyWord;
  MyWord = record
    ch: char;
    next: point
  end;
var
   slovo:point;
{---------------------------------------------------------------------------}
procedure Print (first: point);
Var r: point;
begin
  R:= first;
  write('C/\OBO = ');
  While r<>nil do
    begin
      Write (r^.ch);
      R:=r^.Next;
  end;
  writeln;
end;
{---------------------------------------------------------------------------}
procedure Vvod(var first:point);
var r, last:point;
begin
  first:= nil; last := nil;

   writeln('HABEPuTE C/\OBO C "." HA KOHCE ');
  repeat
      new(r);
      r^.next := nil;
      read(r^.ch);

      if first = nil then first := r
      else last^.next := r;

      last := r;
  until r^.ch = '.';

end;

Procedure insert_before (Var q: point; x: char);
Var r: point;
Begin
  New(r);
  r^.Next:=q^.Next;
  q^.Next:=r;
  r^.ch:=q^.ch;
  q^.ch:=x
end;
{---------------------------------------------------------------------------}
Procedure Delete(Var q: point);
Var r: point;
Begin
  r:=q^.next;
  q^:=r^;
  r^.Next:=nil;
End;
{----------------------------------------------------------------------------}
Procedure MyProc(first:point);
var r,temp:point;
       k:integer;
begin
new(r);
r:=first;
repeat
     k:=0;
     temp:=r;
     if temp = temp^.next then
       begin
          r:=temp;
           while (temp = r^.next) do
              begin
                  inc(k);
                  r:=r^.next;
                  delete(r);
              end;
           insert_before(temp,chr(ord(k)));
       end;
     r:=r^.next;
  write(r^.ch);
until r = nil;
end;

begin
clrscr;
  vvod(slovo);
  print(slovo);
  MyProc(slovo);
  readkey;
  end.