1------------------------------------------------------------------------------ 2-- -- 3-- Matreshka Project -- 4-- -- 5-- Ada Modeling Framework -- 6-- -- 7-- Runtime Library Component -- 8-- -- 9------------------------------------------------------------------------------ 10-- -- 11-- Copyright © 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: 2671 $ $Date: 2012-03-23 00:51:37 +0400 (Fri, 23 Mar 2012) $ 43------------------------------------------------------------------------------ 44-- This file is generated, don't edit it. 45------------------------------------------------------------------------------ 46with AMF.Elements; 47with AMF.Internals.Element_Collections; 48with AMF.Internals.Helpers; 49with AMF.Internals.Tables.OCL_Attributes; 50with AMF.UML.Classifiers; 51with AMF.UML.Comments.Collections; 52with AMF.UML.Dependencies.Collections; 53with AMF.UML.Elements.Collections; 54with AMF.UML.Named_Elements; 55with AMF.UML.Namespaces.Collections; 56with AMF.UML.Packages.Collections; 57with AMF.UML.String_Expressions; 58with AMF.UML.Types; 59with AMF.Visitors.OCL_Iterators; 60with AMF.Visitors.OCL_Visitors; 61with League.Strings.Internals; 62with Matreshka.Internals.Strings; 63 64package body AMF.Internals.OCL_Type_Exps is 65 66 ----------------------- 67 -- Get_Referred_Type -- 68 ----------------------- 69 70 overriding function Get_Referred_Type 71 (Self : not null access constant OCL_Type_Exp_Proxy) 72 return AMF.UML.Classifiers.UML_Classifier_Access is 73 begin 74 return 75 AMF.UML.Classifiers.UML_Classifier_Access 76 (AMF.Internals.Helpers.To_Element 77 (AMF.Internals.Tables.OCL_Attributes.Internal_Get_Referred_Type 78 (Self.Element))); 79 end Get_Referred_Type; 80 81 ----------------------- 82 -- Set_Referred_Type -- 83 ----------------------- 84 85 overriding procedure Set_Referred_Type 86 (Self : not null access OCL_Type_Exp_Proxy; 87 To : AMF.UML.Classifiers.UML_Classifier_Access) is 88 begin 89 AMF.Internals.Tables.OCL_Attributes.Internal_Set_Referred_Type 90 (Self.Element, 91 AMF.Internals.Helpers.To_Element 92 (AMF.Elements.Element_Access (To))); 93 end Set_Referred_Type; 94 95 -------------- 96 -- Get_Type -- 97 -------------- 98 99 overriding function Get_Type 100 (Self : not null access constant OCL_Type_Exp_Proxy) 101 return AMF.UML.Types.UML_Type_Access is 102 begin 103 return 104 AMF.UML.Types.UML_Type_Access 105 (AMF.Internals.Helpers.To_Element 106 (AMF.Internals.Tables.OCL_Attributes.Internal_Get_Type 107 (Self.Element))); 108 end Get_Type; 109 110 -------------- 111 -- Set_Type -- 112 -------------- 113 114 overriding procedure Set_Type 115 (Self : not null access OCL_Type_Exp_Proxy; 116 To : AMF.UML.Types.UML_Type_Access) is 117 begin 118 AMF.Internals.Tables.OCL_Attributes.Internal_Set_Type 119 (Self.Element, 120 AMF.Internals.Helpers.To_Element 121 (AMF.Elements.Element_Access (To))); 122 end Set_Type; 123 124 --------------------------- 125 -- Get_Client_Dependency -- 126 --------------------------- 127 128 overriding function Get_Client_Dependency 129 (Self : not null access constant OCL_Type_Exp_Proxy) 130 return AMF.UML.Dependencies.Collections.Set_Of_UML_Dependency is 131 begin 132 return 133 AMF.UML.Dependencies.Collections.Wrap 134 (AMF.Internals.Element_Collections.Wrap 135 (AMF.Internals.Tables.OCL_Attributes.Internal_Get_Client_Dependency 136 (Self.Element))); 137 end Get_Client_Dependency; 138 139 -------------- 140 -- Get_Name -- 141 -------------- 142 143 overriding function Get_Name 144 (Self : not null access constant OCL_Type_Exp_Proxy) 145 return AMF.Optional_String is 146 begin 147 declare 148 use type Matreshka.Internals.Strings.Shared_String_Access; 149 150 Aux : constant Matreshka.Internals.Strings.Shared_String_Access 151 := AMF.Internals.Tables.OCL_Attributes.Internal_Get_Name (Self.Element); 152 153 begin 154 if Aux = null then 155 return (Is_Empty => True); 156 157 else 158 return (False, League.Strings.Internals.Create (Aux)); 159 end if; 160 end; 161 end Get_Name; 162 163 -------------- 164 -- Set_Name -- 165 -------------- 166 167 overriding procedure Set_Name 168 (Self : not null access OCL_Type_Exp_Proxy; 169 To : AMF.Optional_String) is 170 begin 171 if To.Is_Empty then 172 AMF.Internals.Tables.OCL_Attributes.Internal_Set_Name 173 (Self.Element, null); 174 175 else 176 AMF.Internals.Tables.OCL_Attributes.Internal_Set_Name 177 (Self.Element, 178 League.Strings.Internals.Internal (To.Value)); 179 end if; 180 end Set_Name; 181 182 ------------------------- 183 -- Get_Name_Expression -- 184 ------------------------- 185 186 overriding function Get_Name_Expression 187 (Self : not null access constant OCL_Type_Exp_Proxy) 188 return AMF.UML.String_Expressions.UML_String_Expression_Access is 189 begin 190 return 191 AMF.UML.String_Expressions.UML_String_Expression_Access 192 (AMF.Internals.Helpers.To_Element 193 (AMF.Internals.Tables.OCL_Attributes.Internal_Get_Name_Expression 194 (Self.Element))); 195 end Get_Name_Expression; 196 197 ------------------------- 198 -- Set_Name_Expression -- 199 ------------------------- 200 201 overriding procedure Set_Name_Expression 202 (Self : not null access OCL_Type_Exp_Proxy; 203 To : AMF.UML.String_Expressions.UML_String_Expression_Access) is 204 begin 205 AMF.Internals.Tables.OCL_Attributes.Internal_Set_Name_Expression 206 (Self.Element, 207 AMF.Internals.Helpers.To_Element 208 (AMF.Elements.Element_Access (To))); 209 end Set_Name_Expression; 210 211 ------------------- 212 -- Get_Namespace -- 213 ------------------- 214 215 overriding function Get_Namespace 216 (Self : not null access constant OCL_Type_Exp_Proxy) 217 return AMF.UML.Namespaces.UML_Namespace_Access is 218 begin 219 return 220 AMF.UML.Namespaces.UML_Namespace_Access 221 (AMF.Internals.Helpers.To_Element 222 (AMF.Internals.Tables.OCL_Attributes.Internal_Get_Namespace 223 (Self.Element))); 224 end Get_Namespace; 225 226 ------------------------ 227 -- Get_Qualified_Name -- 228 ------------------------ 229 230 overriding function Get_Qualified_Name 231 (Self : not null access constant OCL_Type_Exp_Proxy) 232 return AMF.Optional_String is 233 begin 234 declare 235 use type Matreshka.Internals.Strings.Shared_String_Access; 236 237 Aux : constant Matreshka.Internals.Strings.Shared_String_Access 238 := AMF.Internals.Tables.OCL_Attributes.Internal_Get_Qualified_Name (Self.Element); 239 240 begin 241 if Aux = null then 242 return (Is_Empty => True); 243 244 else 245 return (False, League.Strings.Internals.Create (Aux)); 246 end if; 247 end; 248 end Get_Qualified_Name; 249 250 -------------------- 251 -- Get_Visibility -- 252 -------------------- 253 254 overriding function Get_Visibility 255 (Self : not null access constant OCL_Type_Exp_Proxy) 256 return AMF.UML.Optional_UML_Visibility_Kind is 257 begin 258 return 259 AMF.Internals.Tables.OCL_Attributes.Internal_Get_Visibility 260 (Self.Element); 261 end Get_Visibility; 262 263 -------------------- 264 -- Set_Visibility -- 265 -------------------- 266 267 overriding procedure Set_Visibility 268 (Self : not null access OCL_Type_Exp_Proxy; 269 To : AMF.UML.Optional_UML_Visibility_Kind) is 270 begin 271 AMF.Internals.Tables.OCL_Attributes.Internal_Set_Visibility 272 (Self.Element, To); 273 end Set_Visibility; 274 275 ----------------------- 276 -- Get_Owned_Comment -- 277 ----------------------- 278 279 overriding function Get_Owned_Comment 280 (Self : not null access constant OCL_Type_Exp_Proxy) 281 return AMF.UML.Comments.Collections.Set_Of_UML_Comment is 282 begin 283 return 284 AMF.UML.Comments.Collections.Wrap 285 (AMF.Internals.Element_Collections.Wrap 286 (AMF.Internals.Tables.OCL_Attributes.Internal_Get_Owned_Comment 287 (Self.Element))); 288 end Get_Owned_Comment; 289 290 ----------------------- 291 -- Get_Owned_Element -- 292 ----------------------- 293 294 overriding function Get_Owned_Element 295 (Self : not null access constant OCL_Type_Exp_Proxy) 296 return AMF.UML.Elements.Collections.Set_Of_UML_Element is 297 begin 298 return 299 AMF.UML.Elements.Collections.Wrap 300 (AMF.Internals.Element_Collections.Wrap 301 (AMF.Internals.Tables.OCL_Attributes.Internal_Get_Owned_Element 302 (Self.Element))); 303 end Get_Owned_Element; 304 305 --------------- 306 -- Get_Owner -- 307 --------------- 308 309 overriding function Get_Owner 310 (Self : not null access constant OCL_Type_Exp_Proxy) 311 return AMF.UML.Elements.UML_Element_Access is 312 begin 313 return 314 AMF.UML.Elements.UML_Element_Access 315 (AMF.Internals.Helpers.To_Element 316 (AMF.Internals.Tables.OCL_Attributes.Internal_Get_Owner 317 (Self.Element))); 318 end Get_Owner; 319 320 -------------------- 321 -- All_Namespaces -- 322 -------------------- 323 324 overriding function All_Namespaces 325 (Self : not null access constant OCL_Type_Exp_Proxy) 326 return AMF.UML.Namespaces.Collections.Ordered_Set_Of_UML_Namespace is 327 begin 328 -- Generated stub: replace with real body! 329 pragma Compile_Time_Warning (Standard.True, "All_Namespaces unimplemented"); 330 raise Program_Error with "Unimplemented procedure OCL_Type_Exp_Proxy.All_Namespaces"; 331 return All_Namespaces (Self); 332 end All_Namespaces; 333 334 ------------------------- 335 -- All_Owning_Packages -- 336 ------------------------- 337 338 overriding function All_Owning_Packages 339 (Self : not null access constant OCL_Type_Exp_Proxy) 340 return AMF.UML.Packages.Collections.Set_Of_UML_Package is 341 begin 342 -- Generated stub: replace with real body! 343 pragma Compile_Time_Warning (Standard.True, "All_Owning_Packages unimplemented"); 344 raise Program_Error with "Unimplemented procedure OCL_Type_Exp_Proxy.All_Owning_Packages"; 345 return All_Owning_Packages (Self); 346 end All_Owning_Packages; 347 348 ----------------------------- 349 -- Is_Distinguishable_From -- 350 ----------------------------- 351 352 overriding function Is_Distinguishable_From 353 (Self : not null access constant OCL_Type_Exp_Proxy; 354 N : AMF.UML.Named_Elements.UML_Named_Element_Access; 355 Ns : AMF.UML.Namespaces.UML_Namespace_Access) 356 return Boolean is 357 begin 358 -- Generated stub: replace with real body! 359 pragma Compile_Time_Warning (Standard.True, "Is_Distinguishable_From unimplemented"); 360 raise Program_Error with "Unimplemented procedure OCL_Type_Exp_Proxy.Is_Distinguishable_From"; 361 return Is_Distinguishable_From (Self, N, Ns); 362 end Is_Distinguishable_From; 363 364 --------------- 365 -- Namespace -- 366 --------------- 367 368 overriding function Namespace 369 (Self : not null access constant OCL_Type_Exp_Proxy) 370 return AMF.UML.Namespaces.UML_Namespace_Access is 371 begin 372 -- Generated stub: replace with real body! 373 pragma Compile_Time_Warning (Standard.True, "Namespace unimplemented"); 374 raise Program_Error with "Unimplemented procedure OCL_Type_Exp_Proxy.Namespace"; 375 return Namespace (Self); 376 end Namespace; 377 378 -------------------- 379 -- Qualified_Name -- 380 -------------------- 381 382 overriding function Qualified_Name 383 (Self : not null access constant OCL_Type_Exp_Proxy) 384 return League.Strings.Universal_String is 385 begin 386 -- Generated stub: replace with real body! 387 pragma Compile_Time_Warning (Standard.True, "Qualified_Name unimplemented"); 388 raise Program_Error with "Unimplemented procedure OCL_Type_Exp_Proxy.Qualified_Name"; 389 return Qualified_Name (Self); 390 end Qualified_Name; 391 392 --------------- 393 -- Separator -- 394 --------------- 395 396 overriding function Separator 397 (Self : not null access constant OCL_Type_Exp_Proxy) 398 return League.Strings.Universal_String is 399 begin 400 -- Generated stub: replace with real body! 401 pragma Compile_Time_Warning (Standard.True, "Separator unimplemented"); 402 raise Program_Error with "Unimplemented procedure OCL_Type_Exp_Proxy.Separator"; 403 return Separator (Self); 404 end Separator; 405 406 ------------------------ 407 -- All_Owned_Elements -- 408 ------------------------ 409 410 overriding function All_Owned_Elements 411 (Self : not null access constant OCL_Type_Exp_Proxy) 412 return AMF.UML.Elements.Collections.Set_Of_UML_Element is 413 begin 414 -- Generated stub: replace with real body! 415 pragma Compile_Time_Warning (Standard.True, "All_Owned_Elements unimplemented"); 416 raise Program_Error with "Unimplemented procedure OCL_Type_Exp_Proxy.All_Owned_Elements"; 417 return All_Owned_Elements (Self); 418 end All_Owned_Elements; 419 420 ------------------- 421 -- Must_Be_Owned -- 422 ------------------- 423 424 overriding function Must_Be_Owned 425 (Self : not null access constant OCL_Type_Exp_Proxy) 426 return Boolean is 427 begin 428 -- Generated stub: replace with real body! 429 pragma Compile_Time_Warning (Standard.True, "Must_Be_Owned unimplemented"); 430 raise Program_Error with "Unimplemented procedure OCL_Type_Exp_Proxy.Must_Be_Owned"; 431 return Must_Be_Owned (Self); 432 end Must_Be_Owned; 433 434 ------------------- 435 -- Enter_Element -- 436 ------------------- 437 438 overriding procedure Enter_Element 439 (Self : not null access constant OCL_Type_Exp_Proxy; 440 Visitor : in out AMF.Visitors.Abstract_Visitor'Class; 441 Control : in out AMF.Visitors.Traverse_Control) is 442 begin 443 if Visitor in AMF.Visitors.OCL_Visitors.OCL_Visitor'Class then 444 AMF.Visitors.OCL_Visitors.OCL_Visitor'Class 445 (Visitor).Enter_Type_Exp 446 (AMF.OCL.Type_Exps.OCL_Type_Exp_Access (Self), 447 Control); 448 end if; 449 end Enter_Element; 450 451 ------------------- 452 -- Leave_Element -- 453 ------------------- 454 455 overriding procedure Leave_Element 456 (Self : not null access constant OCL_Type_Exp_Proxy; 457 Visitor : in out AMF.Visitors.Abstract_Visitor'Class; 458 Control : in out AMF.Visitors.Traverse_Control) is 459 begin 460 if Visitor in AMF.Visitors.OCL_Visitors.OCL_Visitor'Class then 461 AMF.Visitors.OCL_Visitors.OCL_Visitor'Class 462 (Visitor).Leave_Type_Exp 463 (AMF.OCL.Type_Exps.OCL_Type_Exp_Access (Self), 464 Control); 465 end if; 466 end Leave_Element; 467 468 ------------------- 469 -- Visit_Element -- 470 ------------------- 471 472 overriding procedure Visit_Element 473 (Self : not null access constant OCL_Type_Exp_Proxy; 474 Iterator : in out AMF.Visitors.Abstract_Iterator'Class; 475 Visitor : in out AMF.Visitors.Abstract_Visitor'Class; 476 Control : in out AMF.Visitors.Traverse_Control) is 477 begin 478 if Iterator in AMF.Visitors.OCL_Iterators.OCL_Iterator'Class then 479 AMF.Visitors.OCL_Iterators.OCL_Iterator'Class 480 (Iterator).Visit_Type_Exp 481 (Visitor, 482 AMF.OCL.Type_Exps.OCL_Type_Exp_Access (Self), 483 Control); 484 end if; 485 end Visit_Element; 486 487end AMF.Internals.OCL_Type_Exps; 488