MODULE M1

VAR X*: INTEGER;

END M1.

namespace M1
{
    public class Var
    {
        public static int X;
    }
}

namespace A1
{
    class Program
    {
        static void Main(string[] args)
        {
            M1.Var.X++;
            System.Console.WriteLine("M1.Var.X = {0}", M1.Var.X);
            System.Console.ReadLine();
        }
    }
}

namespace A2
{
    class Program
    {
        static void Main(string[] args)
        {
            M1.Var.X++;
            System.Console.WriteLine("M1.Var.X = {0}", M1.Var.X);
            System.Console.ReadLine();
        }
    }
}

DEFINITION Compillers;

TYPE
  Compiller = POINTER TO ABSTRACT RECORD
   (* ... *)
  END;
    
  Directory = POINTER TO ABSTRACT RECORD 
   (f: Directory) New (): Compiller, NEW, ABSTRACT;
   (* ... *)
  END;

VAR
  dir-: Directory;

END Compillers.

IMPORT Compillers;

VAR compiller: Compillers.Compiller;
BEGIN
  compiller := Compillers.dir.New();

PROCEDURE P(dir: Compillers.Directory);

P(Compillers.dir);

P(MyCompillers.myDir);

DEFINITION Models;

TYPE
  Model = POINTER TO ABSTRACT RECORD
   (* ... *)
  END;
    
  Factory = POINTER TO ABSTRACT RECORD 
   (f: Factory) New (): Model, NEW, ABSTRACT;
   (* ... *)
  END;

VAR
  factory-: Factory;

END Models.

DEFINITION Models;

TYPE
  Model = POINTER TO ABSTRACT RECORD
   (* ... *)
  END;
    
  Factory = POINTER TO ABSTRACT RECORD 
   (f: Factory) New (): Model, NEW, ABSTRACT;
   (* ... *)
  END;

VAR
  factory-: Factory;

END Models.

PROCEDURE КлиентскийКод(фабрика: Models.Factory);

КлиентскийКод(Models.factory);

КлиентскийКод(MyModels.myFactory);

MODULE Models;
...

VAR factory- : Factory; (* "-" - означает что переменная экспортируется только для чтения *)

...

BEGIN
  factory := NewConcreteFactory(); (* Инициализация переменной при загрузке модуля в память *)
END Models.

MODULE Models;
...

VAR factory: Factory; (* не экспортируемая приватная переменная этого модуля *)

PROCEDURE Factory* (): Factory; (* "*" - означает что эта процедура экспортируется (публичная) *)
BEGIN
  IF factory = NIL THEN factory := NewConcreteFactory() END; (* Отложенное создание фабрики по первому требованию *)
  RETURN factory;
END Factory;
...

END Models.

MODULE Problem3x1;

VAR bug: BOOLEAN; (* мне лень выдумывать "настоящую" ошибку, поэтому сделаю заподлянку *)

PROCEDURE Measure*(x:INTEGER):INTEGER;
VAR t:INTEGER;
BEGIN
  t := 0;
  WHILE bug OR x<>1 DO (* на Cray-II этот цикл закончится максимум через 6 секунд *)
    t:=t+1;
    IF ODD(x) THEN x:=3*x+1; ELSE x:=x/2; END;
  END;
  Measure := t;
END;

PROCEDURE BugIt*();
BEGIN
  bug := TRUE; (* пример того, как порча своих данных отразится вовне *)
END;

BEGIN
  bug := FALSE;
END Problem3x1;

Singlton::Instance("Heap memory manager")->New(100);
Singlton::Instance("VM memory manager")->New(100);

    Logger logger = LogProvider.getLogger(); // вот тут-то мы жестко и привязались к механизму получения логгера!
    logger.log("some message");

namespace Log
{
    void PrintLog(const std::string &msg)
    {
        Logger *logger = LogProvider::getLogger();
        logger->log(msg);
    }
}

//...
void SomeClass::SomeFunc()
{
    Log::PrintLog("Караул!!!");
}

template<class SingltoneImplT>
class Singltone
{
public:
    SingltoneImplT* Instance();
};

typedef Singltone<HeapMemoryManager> MemoryManager; // Менеджер для выделения в куче
// typedef Singltone<VMMemoryManager> MemoryManager; // Менеджер для выделения в виртуальной
                                                     // памяти - сейчас не используется

void SomeFunc()
{
    MemoryManager::Instance()->New(100); // В зависимости от того, как реально определён
                                         // MemoryManager получаем разные менеджеры.
}

  INodeView = INTERFACE (IAggregate)
    ['{A80E3465-6722-4AF3-8A21-5B7FC32F4156}']
    ... 
  END;

  INodeViewFactory = INTERFACE
    ['{80E6B540-E213-4F7C-A61E-41A8C7AC00C1}']
    FUNCTION    NewNodeView    : INodeView;
  END;

FUNCTION NewNodeView(Aggregate: IAggregate): INodeView;
VAR Factory: INodeViewFactory;
BEGIN
  RESULT := NIL;
  TRY
    Errors.Check_A(Aggregate);
    IF Aggregate.GetAscentInterface(INodeViewFactory, Factory) THEN BEGIN
      RESULT := Factory.NewNodeView();
      RESULT.SetAggregate(Aggregate);
    END ELSE BEGIN
      Errors.NoAggInterface('INodeViewFactory');
    END;
    Errors.Check_R(RESULT);
  EXCEPT ON e: SysUtils.Exception DO Errors.Error(e, 'DNode', 'NewNodeView') END
END;

  IAggregate = INTERFACE (Storable)
    ['{B062A88E-1EF8-4D13-918E-2FD0FDAEC811}']
    FUNCTION    GetAscentInterface (CONST IID: TGUID; OUT Obj): BOOLEAN;
    FUNCTION    GetDirectInterface (CONST IID: TGUID; OUT Obj): BOOLEAN;
    FUNCTION    GetDescendInterface(CONST IID: TGUID; OUT Obj): BOOLEAN;
    PROCEDURE   SetAggregate(NewAggregate: IAggregate);
    PROCEDURE   Delete;
  END;

//------------------------------------------------------------------------------
(*

  FUNCTION GetAscentInterface (CONST IID: TGUID; OUT Obj): BOOLEAN;

Запрос интерфейса по восходящей линии агрегирования. Сначала интерфейс ищется
у самого агрегата. Если запрошенный интерфейс самим агрегатом не реализован, то
запрос пересылается вверх по уровням агрегации; и так до тех пор пока он не
дойдет до среды исполнения. Среда исполнения - самый большой агрегат (агрегат
всех агрегатов).

//------------------------------------------------------------------------------

  FUNCTION GetDirectInterface (CONST IID: TGUID; OUT Obj): BOOLEAN;

Запрос интерфейса реализованного непосредственно самим агрегатом.

//------------------------------------------------------------------------------

  FUNCTION GetDescendInterface(CONST IID: TGUID; OUT Obj): BOOLEAN;

Запрос интерфейса по нисходящей линии агрегирования. Сначала интерфейс ищется
у самого агрегата. Если запрошенный интерфейс самим агрегатом не реализован, то
запрос пересылается вниз (вглубь) по уровням агрегации; и так до тех пор пока
он не дойдет до самого последнего компонента из всех компонентов агрегата.

//------------------------------------------------------------------------------

  PROCEDURE SetAggregate(NewAggregate: IAggregate);

Устанавливает агрегат агрегата, то есть тот агрегат внутри которого находится
(агрегирован) исходный агрегат. Благодаря тому что у агрегата есть ссылка на
содержащий его более крупный агрегат, он может пересылать ему восходящие
запросы по предоставлению услуг по необходимым ему интерфейсам. Поскольку при
смене агрегата может произойти смена предоставляемых интерфейсов, то агрегат,
у которого был вызван метод SetAggregate должен перевызвать этот метод
для своих компонентов (разумеется, с аргументом NewAggregate = SELF).
Если какие-либо интерфейсы были кэшированы, то их надо обновить.

//------------------------------------------------------------------------------

  PROCEDURE Delete;

Уничтожение всех агрегированных компонентов. Поскольку для интерфейсов работает
счетчик ссылок, интерфейсный объект нельзя уничтожить до тех пор пока на него
есть ссылки. Агрегат имеет ссылки на свои компоненты, а компоненты имеют
ссылку на свой агрегат, то есть ссылки являются циклическими. Механизм подсчета
ссылок непригоден в случае наличия циклических ссылок объектов друг на друга.
Циклически ссылающиеся друг на друга объекты, с точки зрения механизма подсчета
ссылок, не уничтожимы. Метод Delete предназначен для того чтобы разорвать
этот замкнутый круг. Внутри этого метода агрегат должен обнулить свою ссылку
на более крупный агрегат, а также вызвать этот метод у всех своих компонентов
и обнулить ссылки на свои компоненты. Таким образом, циклические ссылки будут
разорваны, а объекты уничтожены.

*)
//------------------------------------------------------------------------------

  TAggregate = CLASS (TInterfacedObject, Storable, IAggregate)
  PROTECTED
    FAggregate  : IAggregate;
  PUBLIC
    // IAggregate:..............................................................
    FUNCTION    GetAscentInterface (CONST IID: TGUID; OUT Obj): BOOLEAN;
    FUNCTION    GetDirectInterface (CONST IID: TGUID; OUT Obj): BOOLEAN;
    FUNCTION    GetDescendInterface(CONST IID: TGUID; OUT Obj): BOOLEAN;
    PROCEDURE   SetAggregate(NewAggregate: IAggregate);
    PROCEDURE   Delete;
    // Storable:................................................................
    PROCEDURE   Externalize(CONST Writer: Writer);
    PROCEDURE   Internalize(CONST Reader: Reader);
    PROCEDURE   AfterInternalize;
    FUNCTION    GetClassId : TClassId;
    FUNCTION    GetObjectId: TObjectId;
    CONSTRUCTOR New;
    //..........................................................................
    DESTRUCTOR  Destroy; OVERRIDE;
  END;

FUNCTION TAggregate.GetAscentInterface(CONST IID: TGUID; OUT Obj): BOOLEAN;
BEGIN
  RESULT := SELF.GetInterface(IID, Obj);
  IF (NOT RESULT) AND (SELF.FAggregate <> NIL) THEN BEGIN
    RESULT := SELF.FAggregate.GetAscentInterface(IID, Obj)
  END;
END;

(IUnknown = IInterface) -> Storable -> IAggregate -+ -> IПредметнойОбласти_1
                                                   |
                                                   + -> IПредметнойОбласти_2
                                                   |
                                                   + -> IПредметнойОбласти_3
                                                   |

                                                  ...

Message := ХочуСоздатьОбъектNodeView();
SELF.FAggregate.Handle(Message);
v := Message.NodeView;