1------------------------------------------------------------------------------ 2-- -- 3-- Matreshka Project -- 4-- -- 5-- Ada Modeling Framework -- 6-- -- 7-- Runtime Library Component -- 8-- -- 9------------------------------------------------------------------------------ 10-- -- 11-- Copyright © 2011-2012, Vadim Godunko <vgodunko@gmail.com> -- 12-- All rights reserved. -- 13-- -- 14-- Redistribution and use in source and binary forms, with or without -- 15-- modification, are permitted provided that the following conditions -- 16-- are met: -- 17-- -- 18-- * Redistributions of source code must retain the above copyright -- 19-- notice, this list of conditions and the following disclaimer. -- 20-- -- 21-- * Redistributions in binary form must reproduce the above copyright -- 22-- notice, this list of conditions and the following disclaimer in the -- 23-- documentation and/or other materials provided with the distribution. -- 24-- -- 25-- * Neither the name of the Vadim Godunko, IE nor the names of its -- 26-- contributors may be used to endorse or promote products derived from -- 27-- this software without specific prior written permission. -- 28-- -- 29-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -- 30-- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -- 31-- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -- 32-- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -- 33-- HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -- 34-- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED -- 35-- TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR -- 36-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF -- 37-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING -- 38-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS -- 39-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -- 40-- -- 41------------------------------------------------------------------------------ 42-- $Revision: 2839 $ $Date: 2012-04-12 21:46:12 +0400 (Thu, 12 Apr 2012) $ 43------------------------------------------------------------------------------ 44with Ada.Containers.Hashed_Maps; 45 46with League.Strings.Hash; 47 48package body AMF.Internals.Factories is 49 50 package Universal_String_Factory_Maps is 51 new Ada.Containers.Hashed_Maps 52 (League.Strings.Universal_String, 53 Factory_Constructor, 54 League.Strings.Hash, 55 League.Strings."="); 56 57 URI_Registry : Universal_String_Factory_Maps.Map; 58 Packages : AMF.CMOF.Packages.Collections.Set_Of_CMOF_Package; 59 Module_Registry : 60 array (AMF.Internals.AMF_Metamodel) of Module_Factory_Access; 61 Last_Module : AMF_Metamodel := 0; 62 63 -------------------- 64 -- Create_Factory -- 65 -------------------- 66 67 function Create_Factory 68 (URI : League.Strings.Universal_String; 69 Extent : AMF_Extent) return AMF.Factories.Factory_Access 70 is 71 Position : constant Universal_String_Factory_Maps.Cursor 72 := URI_Registry.Find (URI); 73 74 begin 75 if Universal_String_Factory_Maps.Has_Element (Position) then 76 return Universal_String_Factory_Maps.Element (Position) (Extent); 77 78 else 79 return null; 80 end if; 81 end Create_Factory; 82 83 ----------------- 84 -- Get_Factory -- 85 ----------------- 86 87 function Get_Factory 88 (Metamodel : AMF.Internals.AMF_Metamodel) return Module_Factory_Access is 89 begin 90 return Module_Registry (Metamodel); 91 end Get_Factory; 92 93 ------------------ 94 -- Get_Packages -- 95 ------------------ 96 97 function Get_Packages 98 return AMF.CMOF.Packages.Collections.Set_Of_CMOF_Package is 99 begin 100 return Packages; 101 end Get_Packages; 102 103 -------------- 104 -- Register -- 105 -------------- 106 107 procedure Register 108 (The_Package : not null AMF.CMOF.Packages.CMOF_Package_Access; 109 Constructor : not null Factory_Constructor) is 110 begin 111 URI_Registry.Insert (The_Package.Get_URI.Value, Constructor); 112 Packages.Add (The_Package); 113 end Register; 114 115 -------------- 116 -- Register -- 117 -------------- 118 119 procedure Register 120 (Factory : not null Module_Factory_Access; 121 Module : out AMF_Metamodel) is 122 begin 123 Module := Last_Module; 124 Last_Module := Last_Module + 1; 125 126 Module_Registry (Module) := Factory; 127 end Register; 128 129end AMF.Internals.Factories; 130