program loh;

type
  mnoj = set of char;
  zapis = record
    wordd: string;
    povt: integer;
    next: ^zapis;
  end;
  spisok = ^zapis;
  a = array[1..6] of spisok;

function last(d: spisok; var s: string): boolean;
begin
  while d^.next <> nil do
    d := d^.next;
  if d^.wordd <= s then last := true
  else last := false;
end;

procedure insert(s: string; var p: spisok);//процедура вставки слова в список.
var
  q, t: spisok;

begin
  if p = nil then//если список пуст
  begin
    new(p);
    p^.wordd := s;
    p^.povt := 1;
    p^.next := nil;
  end

    else

  begin//если список не пустой

    q := p;
    if last(p, s) then//проверка на местоположение - в конце или нет
    begin
      while q^.next <> nil do
        q := q^.next;
      if q^.wordd = s then q^.povt := q^.povt + 1 //если повторение, то добавляем
          else
      begin//если нет повторения, то создаем новый узел
        new(t);
        t^.wordd := s;
        t^.next := nil;
        q^.next := t;
        t^.povt := 1;
      end;
    end

    else

    if p^.wordd > s then //заносим в начало, если все слова позже
    begin
      if p^.wordd = s then p^.povt := p^.povt + 1
          else
      begin
        new(q);
        q^.wordd := s;
        q^.next := p;
        q^.povt := 1;
        p := q;
      end;
    end
        else

    begin//находим, между какими словами может располагаться вносимое слово.
      while q^.next^.wordd < s do //через 1 элемент
        q := q^.next;
      if q^.wordd = s then
        q^.povt := q^.povt + 1 //повторение элемента
        else
      begin
        new(t);
        t^.wordd := s;
        t^.next := q^.next;
        q^.next := t;
      end;
    end;
  end;
end;

procedure output(m: a);//процедура вывода массива.
var
  i, j: integer; q: spisok;
begin
  for i := 1 to 6 do
  begin
    if m[i] <> nil then
    begin
      q := m[i];
      while q <> nil do//вывод полностью всех элементов из списка
      begin
        for j := 1 to q^.povt do //количество повторений слова
          write(q^.wordd, ' ');
        q := q^.next;
      end;
      writeln(' - слова из ', i, ' букв(ы)')
    end;
  end;
end;

procedure videl(var c: char; var s: string; var k: integer; allowed: mnoj);//процедура выделения слова из последовательности.
begin
  k := 0;
  c := '^';
  s := '';
  while not (c = '.') and not (c = ',') do
  begin
    read(c);
    if ((not (c in allowed) or ((k = 6) and (c <> '.') and (c <> ','))) and (c <> ' '))  then writeln('Введите другой символ')
    else if (c <> '.') and (c <> ',') and (c <> ' ') then
    begin
      s := s + c; //сложение строки
      k := k + 1; //счетчик буков
    end;
  end;
end;

var
  c: char;
  allowed: mnoj;
  m: a;
  k: integer;
  s: string;

begin
  allowed := ['A'..'Z', ',', '.'];//множество допустимых для ввода символов
  for k := 1 to 6 do //создание массива с пустыми списками
    m[k] := nil;

  while not (c = '.') do//выделение+занос.
  begin
    videl(c, s, k, allowed);
    if k <> 0 then
      insert(s, m[k]);
  end;
  output(m);
  for k := 1 to 6 do//освобождаем память
    dispose(m[k]);
end.