(*
см. Свердлов С.З.(2007)=ЯП и методы трансляции

               Реализация очереди на Обероне-07 по Вирту.

  Поместим описание (и реализацию) абстрактного типа данных (АТД) «очередь»
  в модуль Queue - «очередь».
*)

                     MODULE Queue;
TYPE
  tNode* = POINTER TO tNodeDesc;
                      tNodeDesc* = RECORD (* дескриптор (описатель) вершины\узла *)
         Next : tNode
                                   END;
  tQueue*                        = RECORD (* Абстрактный Тип Данных (АТД) «очередь» *)
        First,
         Last : tNode
                                   END;
(*
Тип tNode — это указатель на элемент очереди (node — вершина\узел),
 а сам элемент имеет тип tNodeDesc — дескриптор (описатель) вершины.
 Звёздочки, сопровождающие идентификаторы tNode, tNodeDesc и tQueue, 
 означают, что эти типы экспортируются модулем Queue, то есть доступны
 для использования другими модулями. Принципиально важно, что имена
 полей Next, First и Last не экспортируются.

Модули, использующие Queue, не будут (и не должны) знать деталей реализации
 очереди — соблюдаются основополагающие принципы АТД — отделение спецификации
 от реализации и упрятывание реализации.

С другой стороны, наш модуль Queue не знает о типах элементов,
 которые фактически будут помещаться в очередь.

Продолжим реализацию (и спецификацию) очереди в модуле Queue.
 Предусмотрим процедуры для инициализации очереди (init),
 добавления (Put) и извлечения (Get) элемента,
 а также логическую процедуру-функцию, позволяющую узнать,
 не пуста ли очередь (NotEmpty).
*)

                                (* Инициализация *)
PROCEDURE Init*(VAR Q: tQueue);
BEGIN
     Q.First := NIL;
     Q.Last := NIL
END Init;
                                (* Добавить в очередь *)
PROCEDURE Put*(VAR Q: tQueue; node: tNode);
BEGIN
  IF Q.First = NIL THEN
     Q.First := node;
  ELSE
     Q.Last.Next := node;
  END;
     Q.Last := node;
               node.Next := NIL;
END Put;
                                (* Удалить из очереди *)
PROCEDURE Get*(VAR Q: tQueue; VAR node: tNode);
BEGIN
  node := Q.First;
          Q.First := Q.First.Next;
       IF Q.First = NIL THEN
          Q.Last := NIL
       END
END Get;
                                (* Очередь не пуста *)
PROCEDURE NotEmpty*(Q: tQueue): BOOLEAN;
BEGIN
  RETURN Q.First # NIL;
END NotEmpty;

END Queue.

(*
Параметром процедур Put и Get является, наряду с очередью Q,
 указатель на добавляемую или извлекаемую вершину, названный node.

 Программа, использующая процедуру Put,
 перед добавлением в очередь элемента должна создать
 динамическую переменную,
 а указатель на эту переменную передать в качестве параметра процедуре Put.

 Предусмотреть создание динамической переменной-элемента списка
 внутри процедуры Put нельзя,
 поскольку тип добавляемого элемента процедуре Put неизвестен.

Вызов процедуры Get в случае, когда очередь пуста, недопустим
 и приведет к аварийному завершению программы.

 Перед обращением к Get следует предусмотреть (с помощью NotEmpty)
 проверку наличия в очереди элементов.

Программный интерфейс (перечень экспортируемых ресурсов), написанного нами модуля,
 может быть получен автоматически с помощью специального инструмента
 Оберон-системы — смотрителя, либо формируется компилятором в ходе трансляции:

DEFINITION Queue;
TYPE
  tNode = POINTER TO tNodeDesc;
                     tNodeDesc = RECORD END;
                     tQueue    = RECORD END;

PROCEDURE Init(VAR Q: tQueue);
PROCEDURE Put( VAR Q: tQueue;     node: tNode);  (* по значению node *)
PROCEDURE Get( VAR Q: tQueue; VAR node: tNode);  (* по  адресу  node *)
PROCEDURE NotEmpty(Q: tQueue):BOOLEAN;
END Queue.
*)

(*
Обратите внимание, что поля записей tNodeDesc и tQueue скрыты.

                 Использование очереди. Наследование
*)
(*
  Теперь рассмотрим, каким образом можно использовать реализованную
  нами очередь. Будем записывать в очередь целые и вещественные числа.
  Для этого в программе, которая оперирует очередью
 (пусть это будет модуль Test) нужно определить два новых типа записей
  и два соответствующих типа указателей.
  Одна пара типов (запись и указатель на нее) будет представлять элемент очереди,
  содержащий целочисленное поле, другая пара — вещественное.
  Оба типа записей должны быть расширением tNodeDesc=нУзелDesc, а
  типы указателей — расширением типа tNode=ДкУзлу.
  Только в этом случае мы сможем обеспечить при вызове процедур Get и Put
  совместимость типов для параметра, обозначающего указатель
  на добавляемую или извлекаемую вершину (параметр node).
  По правилам языка Оберон, указатель типа УзелД может ссылаться
  на переменную-запись, тип которой или УзелDesc, или
  является расширением типа УзелDesc.
*)
                         MODULE Test;
IMPORT
       Queue, Out;
TYPE
  tInt = POINTER TO tIntDesc;                            (* tInt(tNode) *)
                    tIntDesc = RECORD (Queue.tNodeDesc)
     x : INTEGER;                                        (* Целочисленное поле *)
                               END;

  tReal = POINTER TO tRealDesc;                          (* tReal(tNode) *)
                     tRealDesc = RECORD (Queue.tNodeDesc)
     x : REAL;                                           (* Вещественное поле *)
                                 END;

(*
  Модуль Test импортирует модуль Queue и модуль Out,
  содержащий элементарные средства вывода, которые потребуются нам
  для иллюстрации действий с очередью.
  Запись в скобках после слова record означает, что определяемый тип
  является расширением типа, указанного в скобках
  (в нашем случае Queue.tNodeDesc [нУзелDesc] — типа tNodeDesc из модуля Queue).

  Если tIntDesc [цУзелDesc] и tRealDesc [дУзелDesc] — это расширения tNodeDesc,
  то соответствующие типы-указатели tInt [ДкУзлуЦел] и tReal [ДкУзлуВещ]
  считаются расширениями (наследниками) tNode [ДкУзлу].

  Записи цУзелDesc и дУзелDesc наследуют от типа tNodeDesc [нУзелDesc] поле Next,
  хотя и «не знают» об этом.
  Запись цУзелDesc расширяет тип нУзелDesc полем 'х' целого типа,
  a дУзелDesc — полем вещественного типа, также названным 'х'.
*)

(*
  Действия с очередью разместим в процедуре Run, которая является
  частью модуля Test. Предусмотрим описание необходимых переменных.
*)

PROCEDURE    Run*; (* Экспортируется *)
VAR
  Q    : Queue.tQueue; (* Очередь    *)
  int  : tInt;         (* Указатель    на цел. вершину *)
  real : tReal;        (* Указатель    на вещ. вершину *)
  node : Queue.tNode;  (* Указатель    на вершину *)
  i    : INTEGER;      (* Счетчик цикла *)

(*
Заполнение очереди

Для иллюстрации будем помещать в очередь попеременно целые и вещественные значения.
 Запишем 10 пар.
 В качестве целого будем брать значение счетчика цикла i, в качестве вещественного — i/10.
*)

Queue.Init(Q); (* Инициализация очереди Q *)

                  (* Заполнение очереди *)
      i:=1;
WHILE i<=10 DO
  NEW(int); int.x := i; Queue.Put(Q, int);
  NEW(real); real.x := i/10; Queue.Put(Q, real);
  INC(i);
END;

(*
Добавление каждого элемента в очередь выполняется в три приема.
 Вначале с помощью вызова стандартной процедуры new создается динамическая переменная.
 При вызове new (int) она будет иметь тип tIntDesc,
  при вызове new (real) создается переменная типа tRealDesc.
 Затем полю х (в одном случае это поле целого тина, в другом — вещественного) присваивается значение.
 Наконец, вызовом процедуры Put элемент добавляется в очередь.
 Следует обратить внимание, что при двух вызовах Put вместо параметра node
  этой процедуры подставляются указатели разных типов (tInt и tReal).
 Но оба эти типа — расширения tNode, поэтому такая подстановка допустима.

                Обслуживание очереди. Проверка и охрана типа

Теперь предусмотрим (в процедуре Run) обслуживание очереди,
 которое будет состоять просто в печати значений содержащихся в ней чисел
 (с удалением элементов из очереди).
 При этом мы, конечно, не вправе пользоваться знаниями о том,
  в каком порядке в очереди следуют целые и вещественные.
 Однако будем считать, что, кроме целых и вещественных,
  других типов значений в очереди нет.
*)

WHILE Queue.NotEmpty(Q) DO

  Queue.Get(Q,node);
                                 (* Напечатать значение элемента *)
  Out.Ln; (* Переход на новую строку *)
END;

(*
Это лишь набросок цикла обслуживания очереди.
 Вместо фрагмента, где должна быть печать извлеченного из очереди значения — многоточие.
 Рассмотрим, как следует заполнить этот пробел.
 Во-первых, обратите внимание, что при обращении к процедуре Get вместо выходного параметра
  подставлена переменная-указатель node типа tNode.
 Это единственно возможное решение в этой ситуации.
 Записать Queue.Get(Q,int) или Queue.Get(Q,real) нельзя по той простой причине,
  что мы не знаем, какого типа будет очередной элемент.
 Кроме того, это нарушило бы правило совместимости типов Оберона
  и привело бы к ошибке при компиляции.

Чтобы напечатать значение числового поля полученного из очереди элемента, придется проверить тип этого элемента, точнее — тип соответствующего указателя. Для этой цели используем операцию проверки типа языка Оберон — is.
*)
IF node IS tInt THEN
  (* Печатать целочисленное поле x *)
ELSE
  (* Печатать вещественное поле х *)
END;

(*
Условие node IS tInt истинно, если указатель node ссылается на элемент типа tIntDesc, то есть node имеет динамический тип tInt.

Как же выполнить печать, когда тип полученного элемента уже выяснен? Во-первых, модуль Out предоставляет две разных процедуры для печати целых и вещественных — Out. Int и Out. Real соответственно. Использовать Out. Int (node. x, 16) (здесь 16 — ширина поля вывода) нельзя. Дело в том, что переменная node имеет статический тип tNode, который не предусматривает поля х у той записи, указателем на которую он является. Поэтому обращение node.x некорректно. Хотя мы знаем (благодаря предусмотренной проверке), что фактически node будет ссылаться в первом случае на запись с целочисленным, а во втором — с вещественным полем х. Воспользоваться этим можно, лишь предусмотрев контроль фактического типа node непосредственно в момент использования node для обращения к полю х. Конструкция Оберона, обеспечивающая такой контроль, называется «охрана типа». Используя охрану, получим:
*)
IF node IS tInt THEN
  Out.Int( node(tInt).x, 16)
ELSE
  Out.Real( node(tReal).x, 16)
END;

(*
Запись node (tInt) означает, что при выполнении программы будет проверен фактический тип node. Если этот тип — tInt (или расширение tInt), то переменная node рассматривается как имеющая тип tInt (то есть обозначение node (tInt) представляет переменную типа tInt) и, следовательно, наличие целочисленного поля х у записи, на которую ссылается node, в этом случае гарантированно. В этом и состоит смысл охраны типа — она обеспечивает безопасное обращение с указателями в строгом соответствии с их фактическим типом. Если динамический тип node не равен tInt и не является расширением tInt, при выполнении программы происходит ошибка.

Целиком фрагмент, отвечающий за обслуживание очереди, теперь выглядит так:
*)

WHILE
  Queue.NotEmpty(Q)
DO
  Queue.Get(Q, node);
                      (* Передать объекту, на который ссылается указатель node, сообщение "Напечатать значение" *)
  IF node IS tInt THEN
    Out.Int (node(tInt).x, 16)
  ELSE
    Out.Real(node(tReal).x, 16)
  END;
  Out.Ln;
END;

(*
  Такое решение, однако, может вызывать критику, поскольку не соответствует принципам объектного подхода.
  Выяснение типа объекта, полученного из очереди, и выбор варианта поведения происходят на верхнем
  уровне управления. Тем самым объекты лишаются активной роли.
  Вместо этого следовало бы просто передать объекту сообщение: «А ну-ка, напечатайся».
  Организацией такого решения мы сейчас и займемся.
*)

(*
              Обработка сообщений на Обероне-07
*)
(*
  Общая схема обслуживания очереди, основанная на передаче сообщений с переносом активности
  на уровень объектов, будет выглядеть так:
*)
WHILE
  Queue.NotEmpty(Q)
DO
  Queue.Get (Q, node);
                          (* Передать объекту, на который ссылается указатель node,
                             сообщение "Напечатать значение" *)
  Out.Ln;
END;

(*
Передача сообщения будет выполняться с помощью вызова процедуры (которая наверняка будет называться Print — печатать). Эта процедура могла бы выглядеть так:
*)
PROCEDURE Print(node: Queue.tNode);
BEGIN
  IF node IS tInt THEN
    Out.Int (node(tInt).x, 16)
  ELSE
    Out.Real(node(tReal).x, 16)
  END
END Print;

(*
Но в этом случае объекты снова лишаются самостоятельности. Просто появляется промежуточный уровень в виде процедуры Print, на который и переносится решение всех вопросов, связанных с печатью значений. Плохо и то, что при появлении новых типов объектов, которые мы захотим помещать в очередь и значения которых будем печатать, придется переписывать (и перекомпилировать) процедуру Print. То есть добавление нового программного кода (новых типов объектов) будет вынуждать нас менять уже существующий код. Лучше бы без этого обходиться, поскольку такая ситуация способствует снижению надежности программы из-за необходимости постоянной модернизации уже написанного и отлаженного кода. Возможность расширять программу, не вторгаясь в уже существующие ее части, крайне важна44. И рассматриваемая нами технология это позволяет.

Предусмотрим у каждого объекта, который мы добавляем в очередь, поле процедурного типа, значением которого будет процедура (своя для каждого типа объекта), способная напечатать значение объекта данного типа.

Для объекта, содержащего целочисленное значение (объекта типа tInt 45), это будет следующая процедура:
*)

PROCEDURE PrintInt(node: Queue.tNode);
BEGIN
  Out.Int(node(tInt).x, 16);
END PrintInt;

(*
Может показаться, что параметр node этой процедуры можно было сделать типа tInt, и тогда не потребовалось бы использовать охрану типа при обращении к полю х. Ведь охрана типа приводит к дополнительным затратам во время выполнения программы. Но делать так не следует, поскольку все процедуры, исполняющие роль обработчиков сообщений «напечатать», должны иметь один и тот же тип параметра, то есть быть одинакового процедурного типа.

Для объектов типа tReal роль обработчика сообщений будет выполнять процедура PrintReal.
*)

PROCEDURE PrintReal(node: Queue.tNode);
BEGIN
  Out.Real(node(tReal).x, 16);
END PrintReal;

(*
Если считать, что каждый объект (объект каждого типа), который мы записываем в очередь и извлекаем оттуда, должен уметь напечатать свое значение, то поле процедурного типа (это будет поле Print), означающее процедуру, которая печатает значение объекта, следовало бы поместить в описание типа tNodeDesc в модуле Queue. Но делать так мы не будем потому, что это противоречило бы первоначальному замыслу: создать и никогда больше не изменять модуль для работы с очередью. Ведь кроме необходимости печатать, может возникнуть и сколько угодно других потребностей при работе с объектами. И каждый раз менять модуль Queue? Ни в коем случае!

С другой стороны, неразумно помещать иоле Print и в описание каждого конкретного типа объектов (tIntDesc, tRealDesc). Это поле общее для таких объектов, общее и по названию и по типу, поэтому было бы правильно, если бы объекты этих типов унаследовали поле Print от общего типа-предка. Кроме того, если поля Print, пусть и одноименные (как поля х), определить для каждого типа в отдельности, то для обращения к этим полям снова пришлось бы различать типы объектов прямо в цикле обслуживания очереди, от чего мы стремимся уйти.

Назовем новый, общий для tInt и tReal, тип-предок tPrintable — тот, который «умеет» напечатать свое значение. Его описание поместим в разделе типов модуля Test, который теперь будет выглядеть так:
*)

TYPE

tPrintable = POINTER TO tPrintDesc;
                        tPrintDesc = RECORD (Queue.tNodeDesc);
Print : PROCEDURE(node: Queue.tNode);
                                     END;
     tReal = POINTER TO tRealDesc;
                        tRealDesc  = RECORD (tPrintDesc)
   x : REAL;
                                     END;

      tInt = POINTER TO tIntDesc;
                        tIntDesc   = RECORD (tPrintDesc)
   x : INTEGER;
                                     END;

(*
Типы tInt и tReal стали (непосредственными) расширениями tPrintable, а уже этот тип — непосредственное расширение типа tNode из модуля Queue, tInt и tReal остаются при этом (не непосредственными) расширениями tNode (рис. 1.18).

tNode    tNode
---------------
tInt     tReal

Исходная    Новая
---------------------
иерархия    иерархия

Рис. 1.18. Иерархия типов объектов
*)

(*
Замечу, что программа никогда не будет создавать объекты типа tPrintable. В записи соответствующего типа нет даже поля, содержащего значение объекта (вроде поля х). Отсутствует и процедура (вроде PrintInt или PrintReal), которая способна печатать значение объектов такого типа. Подобные типы, которые служат лишь промежуточными звеньями в иерархии наследования, являясь носителями некоторых общих для своих наследников свойств (спецификации свойств), часто называют абстрактными (не путать с концепцией АТД).

Запишем теперь по-новому, в объектном стиле, обслуживание очереди. Но перед этим нужно модернизировать и ее заполнение, поскольку у всех объектов, которые мы записываем в очередь, появилось поле Print, которое необходимо задать.
*)

(* Заполнение очереди *) i := 1;

WHILE i<=10 DO    v
  NEW(int); int.x := i; int.Print := PrintInt;
  Queue.Put(Q, int);
  NEW(real); real.x := i/10; real.Print := PrintReal;
  Queue.Put(Q, real);
  INC(i);
END;
(*
При заполнении поля Print (выполнении присваивания, подобного int. Print : = PrintInt) есть риск ошибиться, назначив объекту обработчик сообщения, не соответствующий типу этого объекта. Ведь все обработчики однотипны (в смысле процедурного типа), и компилятор не обнаружит несоответствия, если мы, к примеру, запишем i nt. Print : = PrintReal. Риск можно снизить, а заодно сделать программу более структурированной, если для создания объектов, назначения им обработчиков сообщения и заполнения поля значения использовать специальные процедуры или даже процедуры-функции.
*)
PROCEDURE Newlnt(i: INTEGER): tInt;
  VAR int : tInt;
BEGIN
  NEW(int); int.x := i; int.Print := PrintInt;
  RETURN int
END Newlnt;

PROCEDURE NewReal(r: REAL): tReal;
  VAR real : tReal;
BEGIN
  NEW(real); real.x := r; real.Print := PrintReal;
  RETURN real
END NewReal;

(*
Используя процедуры функции Newlnt и NewReal, которые создают объекты в памяти, инициализируют их поля и возвращают в качестве своего значения указатели на созданные объекты, заполнение очереди можно записать компактно и выразительно:

   Заполнение очереди +) i : = 1 ;
*)
WHILE i<=10 DO
  Queue.Put(Q, Newlnt(i));
  Queue.Put(Q, NewReal(i/10));
  INC(i);
END;
(*
В языках Объектный Паскаль, Си++, Ява и Си# функции, подобные Newint и NewReal, называются конструкторами. Соответственно, в этих языках есть и немало правил, регулирующих использование конструкторов и заодно усложняющих изучение и реализацию языка. В Обероне, где нет понятия «конструктор» (как нет и понятия «объект»), мы, тем не менее, легко такие конструкторы создаем, обходясь обыкновенными процедурами.

И вот — обслуживание очереди в объектном стиле:
*)
WHILE Queue.NotEmpty(Q) DO
  Queue.Get(Q, node);
  node(tPrintable).Print(node);
  Out.Ln;
END;
(*
Здесь при обращении к полю Print объекта node использована охрана типа, позволяющая убедиться, что объект имеет динамический тип tPrintable (или тип-расширение tPrintable), а следовательно, гарантированно содержит поле Print.
*)
(*
                   Гетерогенная очередь на Обероне-2
*)
(*
Надо сразу сказать, что все программы, написанные в предыдущем разделе на Обероне,
 являются и правильными программами на Обероне-2.
 Но язык Оберон-2 содержит связанные процедуры,
  которые позволяют несколько по-другому реализовать объектный подход при работе с очередью.

Использование полей процедурного типа для придания объектам индивидуального поведения
 обеспечивает максимальную гибкость.
 Значениями таких полей являются процедуры-обработчики сообщений.
 Разные экземпляры объектов одного и того же типа могут иметь разные значения процедурных полей,
  а значит, обладать различным поведением.
 Но такая гибкость часто избыточна.
 Однотипные объекты и вести себя должны, скорее всего, одинаково.
 Кроме того, наличие полей процедурного типа у каждого экземпляра объекта
  увеличивает расход памяти и требует инициализации таких полей каждый раз,
  когда объект создаётся, что связано с дополнительными затратами ресурсов,
  а неверная инициализация или её отсутствие — потенциальная причина ошибок.

Процедуры-обработчики сообщений могут быть связаны не с экземплярами,
 а с типами объектов.
 Подобные процедуры в Обероне-2 и называются «связанными с типом процедурами» (type-bound procedures),
  или просто «связанными процедурами».
 В некоторых языках подобные процедуры и функции носят название методов.
 А типы, с которыми связаны методы, называют классами.

Определим связанные процедуры для типов tInt и tReal.
 Названия процедур будут одинаковы — Print.
 Предполагается, что процедурное поле Print у типа tPrintDesc теперь отсутствует — оно больше не нужно.
 Роль обработчиков сообщений будут играть связанные с типами процедуры.
*)
PROCEDURE (this: tInt) Print;
BEGIN
  Out.Int (this.x, 16)
END Print;

PROCEDURE (this: tReal) Print;
BEGIN
  Out.Real(this.x, 16)
END Print;
(*
Отличительным признаком связанных процедур является параметр-приемник46, описание которого помещается в скобках перед названием процедуры. По типу этого параметра и устанавливается связь процедуры с типом-записью или типом-указателем на запись. В нашем примере параметром-приемником является this — указатель на объект — элемент списка. Внутри связанной процедуры параметр-приемник обозначает тот экземпляр объекта (или указатель на экземпляр объекта), который принимает и обрабатывает сообщение. Отсюда и название, которое я выбрал для параметра-приемника (this — этот). В таких языках, как Ява и Си# слово this даже является зарезервированным, а соответствующий параметр передается методу неявно. Явная спецификация параметра-приемника в Обероне-2 существенно повышает наглядность программы и облегчает понимание.

Связанные процедуры в некотором отношении похожи на поля записей. Обращение к ним выполняется так же, как и к полям. Существование двух связанных с разными типами процедур, имеющих одинаковое название, разрешено, как разрешено определять одноименные поля внутри разных типов (поля х в нашем примере). Но, в отличие от полей, для которых отводится память в каждом экземпляре объекта (переменной-записи), использование связанных процедур не предполагает резервирования памяти для ссылок на них в каждом объекте.

Тип, являющийся расширением другого типа, может иметь связанную процедуру с тем же названием, что имеется у типа-предка. В этом случае типы параметров таких процедур также должны совпадать, а процедура типа-наследника переопределяет соответствующую процедуру типа-предка.

Как и в предыдущих примерах, чтобы запрограммировать обслуживание очереди в объектном стиле, нам потребуется абстрактный промежуточный тип tPr intable. Но поскольку для обработки сообщений теперь используются не поля процедурного типа, а связанные процедуры, с этим типом будет связана абстрактная, не выполняющая никакой реальной работы и никогда не вызываемая процедура Print.
*)
TYPE

tPrintable = POINTER TO tPrintDesc;
                        tPrintDesc = RECORD (Queue.tNodeDesc) END;

PROCEDURE (this: tPrintable) Print;
END Print;
(*
Теперь запишем фрагмент, выполняющий заполнение очереди. В отличие от примеров на Обероне, не требуется заполнять поля процедурного типа, которых уже и нет. Кроме того, уместно применить оператор FOR, которого нет в Обероне, но есть в Обероне-2.
*)

(* Заполнение очереди *)

FOR i := 1 ТО 10 DO

NEW(int); int.x := i;

Queue.Put(Q, int);

NEW(real); real.x := i/10;

Queue.Put(Q, real);

END;
(*
Можно, как и раньше, использовать процедуры-конструкторы, которые теперь освобождаются от обязанности заполнять процедурные поля.

И, наконец, можем запрограммировать обслуживание очереди.
*)
WHILE
  Queue.NotEmpty(Q)
DO
  Queue.Get(Q, node);     (* Получить    *)
  node(tPrintable).Print; (* Напечатать    *)
  Out.Ln;                 (* Перевод строки *)
END;
(*
Ключевую роль играет здесь оператор node (tPrintable) .Print. Исполняется он следующим образом. Вначале с помощью охраны типа проверяется, имеет ли указатель node динамический тип tPrintable или тип, являющийся расширением tPrintable. В нашем случае это условие выполнено, поскольку node указывает либо на элемент типа tIntDesc, либо на элемент типа tRealDesc, то есть node имеет либо динамический тип tInt, либо — tReal. И тот, и другой являются расширениями tPrintable. Охрана не препятствует дальнейшей работе, поскольку все типы начиная с tPrintable имеют связанную процедуру Print. Далее происходит вызов процедуры Print, связанной с динамическим типом node. То есть если node имеет динамический тип tInt, то вызывается Print, связанная с tInt и умеющая печатать целочисленное значение, если node -- типа tReal, то вызывается связанная с этим типом процедура Print.

Такой механизм вызова процедур, когда фактически вызванная процедура становится известна только на этапе выполнения программы, называется поздним связыванием. Впрочем, позднее связывание имеет место и при использовании нолей процедурного типа. Рассмотрение приведенного фрагмента даег повод упомянуть еще один термин, используемый в разговорах про ООП, — полиморфизм. Проявляется полиморфизм в том, что за некоторыми обозначениями в нашей программе могут скрываться объекты разной природы. Так, в операторе node (tPrintable) .Print идентификатор node может обозначать указатель и на объект с целочисленным значением и на объект с вещественным значением, а если расширить систему типов, то node будет соответствовать еще большему набору (без всякого изменения самого оператора). За названием Print скрываются в действительности три разные процедуры.
*)
(*
                          Очередь — тоже объект
*)
(*
Использованный нами объектный подход и связанные процедуры в частности, можно применить и к модулю, реализующему операции с очередью. Действительно, если элементы очереди мы рассматриваем как объекты, то почему бы и самой очереди не быть объектом? Препятствий для этого нет. Будем считать очередь активным объектом, и вместо того чтобы вызывать, например, процедуру для добавления элемента к очереди и передавать очередь, в которую надо что-то добавить, в качестве параметра этой процедуре, мы будем посылать очереди сообщение «добавь элемент». Она и добавит.

На самом деле большой разницы в этих двух подходах нет. Ведь передача сообщения — это не что иное, как вызов процедуры. А очередь в качестве параметра этой процедуре все равно передается. Только теперь это будет параметр-приемник. И говорим мы обо всем немного другими словами.

В листинге 1.12 приведен полный текст модернизированного модуля для работы с очередью.

Листинг 1.12. Модуль для работы с очередью, использующий связанные процедуры
*)
MODULE Queue;
TYPE
  tNode* = POINTER TO tNodeDesc;
                      tNodeDesc* = RECORD
       Next : tNode
                                   END;
  tQueue* = RECORD
                   First,
                    Last : tNode
            END;
                                           (* Инициализировать *)
PROCEDURE (VAR Q: tQueue) Init;
BEGIN
  Q.First := NIL; Q.Last := NIL;
END Init;
                                           (* Добавить элемент *)
PROCEDURE (VAR Q: tQueue) Put*(node: tNode);
BEGIN
  IF
       Q.First = NIL
  THEN
       Q.First := node
  ELSE
       Q.Last.Next := node
  END;
       Q.Last := node;
                 node.Next := NIL
END Put;
                                           (* Получить элемент *)
PROCEDURE (VAR Q: tQueue) Get*(VAR node: tNode);
BEGIN
   node := Q.First;
           Q.First := Q.First.Next;
  IF
           Q.First = NIL
  THEN
           Q.Last := NIL
  END
END Get;
                                           (* He пуста ли очередь? *)
PROCEDURE (VAR Q: tQueue) NotEmpty():BOOLEAN;
BEGIN
  RETURN Q.First # NIL; 
END NotEmpty;

END Queue.
(*
                    Листинг 1.12 (продолжение)
*)
(*
Обратите внимание, что в роли приемников связанных процедур используются
 параметры-переменные типа запись (tQueue).
 Тип указателя на очередь мы не определяем.

 Если параметр-приемник — это запись, а не указатель на запись,
  в его описании по правилам Оберона-2 должно присутствовать слово var.

 Поэтому var используется даже в процедуре-функции NotEmpty,
  которая не изменяет очередь.

Интерфейс модуля Queue, сформированный компилятором JOB, выглядит так: DEFINITION Queue;
*)
TYPE
  tNode = POINTER TO tNodeDesc;
                     tNodeDesc = RECORD END;
  tQueue = RECORD
           END;

PROCEDURE ( VAR Q : tQueue ) Init;
PROCEDURE ( VAR Q : tQueue ) Put(     node : tNode );  (* по значению node *)
PROCEDURE ( VAR Q : tQueue ) Get( VAR node : tNode );  (* по  адресу  node *)
PROCEDURE ( VAR Q : tQueue ) NotEmpty():BOOLEAN;

END Queue.
(*
Поскольку мы рассматривали много разных вариантов заполнения и обслуживания очереди, цельное представление о том, как должна быть организована программа, работающая с очередью, наверное, оказалось потерянным. Чтобы восстановить это представление, привожу полный текст модуля Test (листинг 1.13), в котором заполняется и обслуживается (в процедуре Run) очередь. При этом используется последняя версия модуля Queue.

Листинг 1.13. Использование объектно-ориентированной очереди
*)
MODULE Test;

IMPORT
  Queue, Out;

TYPE
  tPrintable = POINTER TO tPrintDesc; tPrintDesc = RECORD (Queue.tNodeDesc) END;
  tInt       = POINTER TO tIntDesc; tIntDesc = RECORD (tPrintDesc) x : INTEGER END;
  tReal      = POINTER TO tRealDesc; tRealDesc = RECORD (tPrintDesc) x : REAL END;

                                (* Связанные с типом RECORD (классом) процедуры (методы класса) *)
PROCEDURE (this:tPrintable):Print;
END Print;

PROCEDURE (this:tInt):Print;
BEGIN
  Out.Int(this.x, 16)
END Print;

PROCEDURE (this:tReal):Print;
BEGIN
  Out.Real(this.x, 16)
END Print;
                                     (* Конструкторы (класса) *)
PROCEDURE Newlnt(i:INTEGER):tInt;
VAR
         int : tInt;
BEGIN
     NEW(int);
         int.x := i;
  RETURN int
END Newlnt;

PROCEDURE NewReal(r:REAL):tReal;
VAR
         real : tReal;
BEGIN
     NEW(real);
         real.x := r;
  RETURN real
END NewReal;

PROCEDURE Run;
VAR
    Q : Queue.tQueue;
 node : Queue.tNode;
    i : INTEGER;
BEGIN
                        (* Инициализация *)
  Q.Init ();
                        (* Заполнение *)
  FOR i := 1 TO 10 DO
    Q.Put ( Newlnt(i) );
    Q.Put( NewReal(i/10) )
  END;
                        (* Обслуживание *)
  WHILE Q.NotEmpty() DO
    Q.Get(node);
          node(tPrintable).Print;
    Out.Ln
  END
END Run;

END Test.