uses sysutils;

type
  MorphemeType = (
    PREFIX, ROOT, SUFFIX, TERMINATION
  );
const
  {
    Собственно, строковое представление типов морфем,
    с которыми будем работать. Нужно для удобного определения
    типа морфемы в функции GetMorphemInfo
  }
  szMorphTypes: array [MorphemeType] of string = (
    'PREFIX', 'ROOT', 'SUFFIX', 'TERMINATION'
  );

{ далее описываем структуру для реализации списка }
type
  PTListItem = ^TListItem;
  { Это - элемент списка (сама строка и Next) }
  TListItem = record
    value: string;
    next: PTListItem;
  end;
  {
    Это - в первую очередь для удобства, чтобы не хранить указатели
    на "голову" и "хвост" отдельно; во вторую очередь - для возможности
    инициализации списка }
  TList = record
    first, last: PTListItem;
  end;


{ Дальше идет обычная процедура работы со списком: }

{
  Для инициализации - обNILяем поля first, last ...
  На самом деле этого можно не делать (процедуру тоже можно убрать,
  она не нужна больше), это остаток первого варианта программы,
  теперь инициализация происходит еще на этепе компиляции, прямо
  при описании массива In_List...
}
procedure CreateList(var L: TList);
begin
  L.first := nil; L.last := nil;
end;
{
  ... для удаления списка - проходим по нему и освобождаем память,
  выделенную для хранения элементов списка ...
}
procedure DestroyList(var L: TList);
var T: ptlistitem;
begin
  while L.first <> nil do begin
    T := L.first;
    L.first := L.first^.next;
    dispose(T);
  end;
end;

{ ... для добавления значения Value в конец списка: }
procedure AppendToList(var L: TList; const value: string);
var p: PTListItem;
begin
  { выделяем под него память }
  new(p);
  { сохраняем Value во вновь выделенном элементе }
  p^.value := value;
  p^.next := nil;

  {
    и устанавливаем указатели так, чтобы
    только что добавленный элемент стал "хвостовым"
  }
  if L.first = nil then L.first := p
  else L.last^.next := p;

  L.last := p;
end;

{ Функция проверки существования элемента Value в списке L }
function ExistsInList(L: TList; const value: string): boolean;
var p: ptlistitem;
begin
  ExistsInList := true;
  p := L.first;
  while p <> nil do begin
    if p^.value = value then exit;
    p := p^.next;
  end;
  ExistsInList := false;
end;

{
  Сортировка списка: рекурсивный алгоритм, взятый из Sedgewick-а
  В принципе, можно использовать любой другой метод сортировки
} 
procedure SortList(var Ls: TList);
  function insert_sort(l: ptlistitem): ptlistitem;

    function insert(a: ptlistitem; l: ptlistitem): ptlistitem;
    begin
      a^.next := nil;
      if l = nil then insert := a
      else
        if a^.value < l^.value then begin
          a^.next := l; insert := a;
        end
        else begin
          l^.next := insert(a, l^.next);
          insert := l;
        end;
    end;

  begin
    if l = nil then insert_sort := nil
    else insert_sort := insert(l, insert_sort(l^.next));
  end;

begin
  Ls.first := insert_sort(Ls.first);
end;

{ Вывод списка на экран }
procedure PrintList(var L: TList);
var p: PTListItem;
begin
  {
    чтобы не заморачиваться и не забыть ГДЕ-ТО отсортировать список,
    сортируем его непосредственно перед выводом...
  }
  SortList(L); 

  p := L.first;
  while p <> nil do begin
    writeln(p^.value);
    p := p^.next;
  end;
end;

{
  Определяем место для хранения 4-х списков (по количеству типов морфем).
  Именно в таком виде - array[MorphemeType], чтобы при изменении числа
  типов морфем программа заставила бы пользователя внести необходимые
  изменения: если добавить в MorphemeType еще один элемент, то программа
  откажется компилироваться до тех пор, пока в in_list не будет добавлена
  дополнительная инициализация списка...
}
const
  in_list: array[MorphemeType] of TList = (
    (first:nil; last:nil),
    (first:nil; last:nil),
    (first:nil; last:nil),
    (first:nil; last:nil)
  );

{
  Одна из основных процедур - указываем условия, при которых
  морфемы разных типов добавляются в СВОЙ список
}
procedure AppendMorph(mt: morphemetype; var value: string);
begin
  if
    { любой не ROOT добавляется только если в его списке еще нет такого же значения }
    ((mt <> ROOT) and (not ExistsInList(in_list[mt], value)))
    or
    (mt = ROOT) { ROOT же добавляется безусловно, дубликаты возможны }
  then begin
    AppendToList(in_list[mt], value);
  end;
end;

{
  Функция, получающая по прочитанной из файла строке
  саму морфему (Value) и ее тип (результат функции)
}
function GetMorphemInfo(const s: string;
         var value: string): MorphemeType;
var
  temp: string;
  p: integer;
  mt: morphemetype;
begin
  p := pos(' ', s);
  temp := copy(s, p + 1, 255);
  for mt := low(mt) to high(mt) do begin
    {
      если кусок строки после пробела совпал с одним из
      значений szMorphTypes, значит тип найден
    }
    if temp = szMorphTypes[mt] then begin
      GetMorphemInfo := mt;
    end;
  end;
  value := copy(s, 1, p - 1); { возвращаем саму морфему }
end;


var
  morphFile: Text;
  temp, value: string;
  mt: morphemetype;

begin
  assign( morphFile, 'morphems.txt' );
  reset( morphFIle );

  { Основная обработка файла: }
  while not eof ( morphFile ) do begin
    { Читаем строку temp }
    readln( morphFIle, temp );
    {
      1. Получаем функцией GetMorphemInfo тип морфемы из
      прочитанной строки;
      2. Передаем этот тип (не сохраняя в промежуточной переменной)
      в AppendMorph;
      3. Поскольку и в GetMorphemInfo и в AppendMorph параметр Value
      описан как VAR, в процедуру AppendMorph передастся именно то
      значение Value, которое вернется из GetMorphemInfo...
    }
    AppendMorph(GetMorphemInfo(temp, value), value);
  end;

  { Печатаем все списки, как только очередной список напечатан - удаляем его }
  for mt := low(mt) to high(mt) do begin
    PrintList(in_list[mt]);
    DestroyList(in_list[mt]);
  end;

  {
    Все, файл можно закрывать (хотя на самом деле его можно было закрыть
    еще перед печатью списков)
  }
  close( morphFile ); 
  readln;
end.