1. generic 
  2.     type Object_Class (<>) is abstract tagged limited private; 
  3.     type Object_Access is access Object_Class'Class; 
  4.  
  5.     with procedure Delete( e : in out Object_Access ); 
  6.  
  7. -- This generic package is used to register an association of object class 
  8. -- names and allocators. This allows us to instantiate an object simply by class 
  9. -- name, without ever referencing its implementation in the code. 
  10. package Object_Factory is 
  11.  
  12.     type Allocator is access function return Object_Access; 
  13.  
  14.     -- Initializes the factory by name. The name should be the root type of 
  15.     -- objects that it manufactures. (ex: "entity", "actor", etc). Classes 
  16.     -- should be registered before the factory is initialized, preferably at 
  17.     -- elaboration time. Template instances of each registered class are created 
  18.     -- at initialization. An exception will be raised on error, from the first 
  19.     -- failure to instantiate a template instance. 
  20.     procedure Initialize( factoryName : String ); 
  21.     pragma Precondition( factoryName'Length > 0 ); 
  22.  
  23.     -- Finalizes the factory, deleting template instances. 
  24.     procedure Finalize; 
  25.  
  26.     -- Returns null if no allocator is registered for the given class id. If 
  27.     -- the allocator registered for 'id' raises an exception, it will be passed 
  28.     -- on to the caller. 
  29.     function Allocate( id : String ) return Object_Access; 
  30.     pragma Precondition( id'Length > 0 ); 
  31.  
  32.     -- Iterate over the registered class id strings. 
  33.     procedure Iterate_Classes( examine : access procedure( id : String ) ); 
  34.  
  35.     -- Registers a class allocation function with a class id. 
  36.     procedure Register_Class( id : String; allocate : not null Allocator ); 
  37.     pragma Precondition( id'Length > 0 ); 
  38.  
  39.     -- Returns a reference to a template instantiation of the class registered 
  40.     -- with 'id'. Template entities are instantiated when the factory package is 
  41.     -- initialized. If no class is registered for the id, null will be returned. 
  42.     -- Do not modify the object that is returned! 
  43.     function Template( id : String ) return Object_Access; 
  44.     pragma Precondition( id'Length > 0 ); 
  45.  
  46. end Object_Factory;