(*****************************************************************************
 * su4sml --- an SML repository for managing (Secure)UML/OCL models
 *             http://projects.brucker.ch/su4sml/
 *                                                                            
 * xmi_idtable.sml --- 
 * This file is part of su4sml.
 *
 * Copyright (c) 2005-2007 ETH Zurich, Switzerland
 *               2008-2009 Achim D. Brucker, Germany
 *
 * All rights reserved.
 *
 * Redistribution and use in source and binary forms, with or without
 * modification, are permitted provided that the following conditions are
 * met:
 *
 *     * Redistributions of source code must retain the above copyright
 *       notice, this list of conditions and the following disclaimer.
 *
 *     * Redistributions in binary form must reproduce the above
 *       copyright notice, this list of conditions and the following
 *       disclaimer in the documentation and/or other materials provided
 *       with the distribution.
 *
 *     * Neither the name of the copyright holders nor the names of its
 *       contributors may be used to endorse or promote products derived
 *       from this software without specific prior written permission.
 *
 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
 * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
 * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
 * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
 * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
 * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
 * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
 * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
 * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
 * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
 * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 ******************************************************************************)
(* $Id$ *)

structure Xmi_IDTable = 
struct
open Rep_Helper

(**
 * special keys:
 *    - aends introduced to handle the implicit aend of association 
 *      classes for their association: 
 *      (xmiid of the association class)_aend
 *    - associations split off from their association class:
 *      (xmiid of the association class)_association
 * 
 * 
 * 
 * 
 *)
datatype HashTableEntry = Package of Rep_OclType.Path
		        | Type of (Rep_OclType.OclType * 
				   (*(XMI.AssociationEnd list)* *)
				   (Rep_OclType.Path list)*  (* associations *)
				   (Rep_OclType.Path)*       (* association of an association class *)
				   XMI.Classifier * 
				   (XMI.ActivityGraph list)) 
			| Association of (Rep_OclType.Path * 
					 XMI.Association)
                        | Generalization of (string * string) 
			| Constraint of XMI.Constraint 
		        | Stereotype of string
		        | Variable of XMI.VariableDeclaration 
			| Attribute of Rep_OclType.Path
			| AssociationEnd of (Rep_OclType.Path *
					    XMI.AssociationEnd)
			| Operation of Rep_OclType.Path
			| State of XMI.StateVertex
			| Transition of XMI.Transition 
		        | Dependency of XMI.Dependency
		        | TagDefinition of string
		        | ClassifierInState of string 
		        | Event of XMI.Event
			| UniqueName of int (* xmiid=-1;for naming when a name is missing *)
 
fun next_unique_name t:string=
    let
	val number = case valOf (HashTable.find t "-1")
		      of UniqueName x => x
		       | _ => raise Option
    in
	(HashTable.insert t ("-1",UniqueName (number+1));
	 Int.toString number
	)
    end 
    handle Option => Logger.error ("expected UniqueName to be defined in table")
 
fun find_tagdefinition t xmiid =
    (case valOf (HashTable.find t xmiid) 
      of TagDefinition x => x
       | _                => raise Option) 
    handle Option => Logger.error ("expected TagDefinition "^xmiid^" in table")

fun find_state t xmiid = 
    (case valOf (HashTable.find t xmiid) 
      of State x => x
       | _                => raise Option) 
    handle Option => Logger.error ("expected State "^xmiid^" in table")

fun find_event t xmiid = 
    (case valOf (HashTable.find t xmiid) 
      of Event x => x
       | _                => raise Option) 
    handle Option => Logger.error ("expected Event "^xmiid^" in table")

fun find_transition t xmiid = 
    (case valOf (HashTable.find t xmiid) 
      of Transition x => x
       | _                => raise Option) 
    handle Option => Logger.error ("expected Transition "^xmiid^" in table")

fun find_dependency t xmiid = 
    (case valOf (HashTable.find t xmiid) 
      of Dependency x => x
       | _                => raise Option) 
    handle Option => Logger.error ("expected Dependency "^xmiid^" in table")

fun find_generalization t xmiid = 
    (case valOf (HashTable.find t xmiid) 
      of Generalization x => x
       | _                => raise Option) 
    handle Option => Logger.error ("expected Generalization "^xmiid^" in table")

fun find_stereotype t xmiid =
    (case valOf (HashTable.find t xmiid) 
      of Stereotype x => x
       | _                => raise Option) 
    handle Option => Logger.error ("expected Stereotype "^xmiid^" in table")

fun find_attribute t xmiid =
    (case valOf (HashTable.find t xmiid) 
      of Attribute x => x
       | _                => raise Option) 
    handle Option => Logger.error ("expected Attribute "^xmiid^" in table")

fun find_operation t xmiid =
    (case valOf (HashTable.find t xmiid) 
      of Operation x => x
       | _                => raise Option) 
    handle Option => Logger.error ("expected Operation "^xmiid^" in table")

fun find_type t xmiid = 
    (case valOf (HashTable.find t xmiid) 
      of Type x  => x
       | _                => raise Option) 
    handle Option => Logger.error ("expected Type "^xmiid^" in table (find_type)")

fun find_assoc t xmiid = 
    (case valOf (HashTable.find t xmiid) 
      of (Association(path,assoc))  => assoc
       | _                => raise Option) 
    handle Option => Logger.error ("expected Type "^xmiid^" in table (find_assocs)")

fun find_aend t xmiid =
    (case valOf (HashTable.find t xmiid) 
      of (AssociationEnd(path,aend)) => aend
       | _                => raise Option) 
    handle Option => Logger.error ("expected AssociationEnd "^xmiid^" in table (find_aend)")

fun find_variable_dec t xmiid =
    (case valOf (HashTable.find t xmiid) 
      of Variable x => x
       | _                => raise Option) 
    handle Option => Logger.error ("expected VariableDeclaration "^xmiid^" in table")

fun find_parent t xmiid = #2 (find_generalization t xmiid)

fun find_package t xmiid  = 
    (case valOf (HashTable.find t xmiid) 
      of Package path => path
       | _                => raise Option) 
    handle Option => Logger.error ("expected Path "^xmiid^" in table")
					
fun path_of_classifier (Rep_OclType.Classifier x) = x
  | path_of_classifier _ = Logger.error ("path_of_classifier called on non-Classifier argument")

fun find_constraint t xmiid =
    (case valOf (HashTable.find t xmiid) 
      of Constraint c => c
       | _                => raise Option) 
    handle Option => Logger.error ("expected Constraint "^xmiid^" in table")

fun find_associationend t xmiid  = 
    (case valOf (HashTable.find t xmiid) 
      of AssociationEnd (path,ae) => ae
       | _                   => raise Option) 
    handle Option => Logger.error ("expected AssociationEnd "^xmiid^" in table")


fun path_of_association t xmiid  = 
    (case valOf (HashTable.find t xmiid) 
      of Association (path,ae) => path
       | _                   => raise Option) 
    handle Option => Logger.error ("expected Association "^xmiid^" in table") 

fun path_of_associationend t xmiid  = 
    (case valOf (HashTable.find t xmiid) 
      of AssociationEnd (path,ae) => path
       | _                   => raise Option) 
    handle Option => Logger.error ("expected AssociationEnd "^xmiid^" in table") 


fun find_association t xmiid  = 
    (case valOf (HashTable.find t xmiid) 
      of Association (p,a) => a
       | _                   => raise Option) 
    handle Option => Logger.error ("expected Association "^xmiid^" in table")


fun find_association_of_associationend t xmiid =
    let 
	val aend = find_associationend t xmiid
	val assoc_xmiid = #association aend
    in
	find_association t assoc_xmiid
    end

fun find_classifier_associations t xmiid =
    (case valOf (HashTable.find t xmiid) 
      of Type(_,assocs,_,_,_) => assocs
       | _                   => raise Option) 
    handle Option => Logger.error ("expected Association "^xmiid^" in table")
		     
fun filter_exists t cs = 
	filter (fn x => Option.isSome (HashTable.find t x)) cs 

fun filter_precondition t  cs 
  = filter (fn x => let val constraint = find_constraint t x
			val name = #name constraint
			val constr_type_ref = #constraint_type constraint
			val constr_type_name = find_stereotype t constr_type_ref
		    in 
			constr_type_name = "pre"
		    end) cs

fun filter_postcondition t cs
  = filter (fn x => let val constraint = find_constraint t x
			val name = #name constraint
			val constr_type_ref = #constraint_type constraint
			val constr_type_name = find_stereotype t constr_type_ref
		    in 
			constr_type_name = "post"
		    end) cs

fun filter_bodyconstraint t cs
  = filter (fn x => let val constraint = find_constraint t x
			val name = #name constraint
			val constr_type_ref = #constraint_type constraint
			val constr_type_name = find_stereotype t constr_type_ref
		    in 
			constr_type_name = "body"
		    end) cs

fun find_classifier_entries t xmiid =
    let
	val _ = Logger.debug2 "Xmi_IDTable.find_classifier_entries \n"
	val res = (case valOf (HashTable.find t xmiid) of 
		      Type c => c
		    | _  => raise Option
		  ) handle Option => Logger.error ("expected Classifier "^xmiid^" in table (in find_classifer_entries)")
	val _ = Logger.debug2 "end Xmi_IDTable.find_classifiers_entries \n"
    in
	res
    end
									  
fun find_classifier t xmiid =
    (case valOf (HashTable.find t xmiid) 
      of Type (_,_,_,c,_) => c
       | _                => raise Option) 
    handle Option =>  Logger.error ("expected Classifier with xmiid '"^xmiid^"' in table (in find_classifer)")
	 

fun exists_classifier t xmiid =
    (case valOf (HashTable.find t xmiid) 
      of Type (_,_,_,_,_) => true
       | _                => false) 

fun find_classifierInState_classifier t cis_id =
    (case valOf (HashTable.find t cis_id)
      of ClassifierInState c => find_classifier t c
       | Type (_,_,_,c,_)      => c
	   | _                   => raise Option)
    handle Option =>  Logger.error ("expected ClassifierInState "
				       ^cis_id^" in table")
fun find_association_of_associationclass t xmiid =
    (case valOf (HashTable.find t xmiid) 
      of Type (_,_,ac,_,_) => ac
       | _                => raise Option) 
    handle Option => Logger.error ("expected associationclass "^xmiid^" in table (in find_association_of_associationclass)") 

fun find_activity_graph_of t xmiid = 
    (case valOf (HashTable.find t xmiid) 
      of Type (_,_,_,_,ag) => ag
       | _                => raise Option) 
    handle Option => Logger.error ("expected Classifier "^xmiid^" in table (in find_activity_graph_of)")

			
fun find_classifier_type t xmiid
  = let val ocltype = case valOf (HashTable.find t xmiid) of (Type (x,xs,ac,_,_)) => x
							   | _  => raise Option
    in 
	case ocltype of Rep_OclType.Integer      => ocltype
		      | Rep_OclType.String       => ocltype
		      | Rep_OclType.Real         => ocltype
		      | Rep_OclType.Boolean      => ocltype
		      | Rep_OclType.Classifier x => ocltype
		      | Rep_OclType.OclVoid      => ocltype
		      | Rep_OclType.OclAny       => ocltype
		      | Rep_OclType.DummyT       => ocltype
		      | Rep_OclType.Collection (Rep_OclType.Classifier [x]) => Rep_OclType.Collection (find_classifier_type t x)
		      | Rep_OclType.Sequence   (Rep_OclType.Classifier [x]) => Rep_OclType.Sequence (find_classifier_type t x)
		      | Rep_OclType.Set        (Rep_OclType.Classifier [x]) => Rep_OclType.Set (find_classifier_type t x)
		      | Rep_OclType.Bag        (Rep_OclType.Classifier [x]) => Rep_OclType.Bag (find_classifier_type t x)
		      | Rep_OclType.OrderedSet (Rep_OclType.Classifier [x]) => Rep_OclType.OrderedSet (find_classifier_type t x)
		      (* <ArgoUML-Hack> *)
		      | Rep_OclType.Collection (Rep_OclType.Classifier c) => 
			let val _ = Logger.warn ("ArgoUML workaround for supporting collection types ...")
			in Rep_OclType.Collection (Rep_OclType.Classifier c) end
		      | Rep_OclType.Sequence   (Rep_OclType.Classifier c) => 
			let val _ = Logger.warn ("ArgoUML workaround for supporting collection types ...")
			in Rep_OclType.Sequence (Rep_OclType.Classifier c) end 
		      | Rep_OclType.Set        (Rep_OclType.Classifier c) => 
			let val _ = Logger.warn ("ArgoUML workaround for supporting collection types ...")
			in Rep_OclType.Set (Rep_OclType.Classifier c) end
		      | Rep_OclType.Bag        (Rep_OclType.Classifier c) => 
			let val _ = Logger.warn ("ArgoUML workaround for supporting collection types ...")
			in Rep_OclType.Bag (Rep_OclType.Classifier c) end 
		      | Rep_OclType.OrderedSet (Rep_OclType.Classifier c) => 
			let val _ = Logger.warn ("ArgoUML workaround for supporting collection types ...")
			in Rep_OclType.OrderedSet (Rep_OclType.Classifier c) end 
		      (* </ArgoUML-Hack> *)
		      | _ => Logger.error ("unexpected Classifier-Type "^xmiid^" in table")
	 end
	handle Option => Logger.error ("expected Classifier with xmiid '"^xmiid^"' in table (in find_classifer_type)")		    

fun find_association_path t xmiid = 
    case valOf (HashTable.find t xmiid) of (Association (x,xs)) => x
					 | _  => raise Option
    handle Option => Logger.error ("expected Association "^xmiid^" in table (in find_association_path)")	    

fun find_association_name t xmiid = 
    case valOf (HashTable.find t xmiid) of (Association (_,{xmiid,name,connection})) => name
					 | _  => raise Option
    handle Option => Logger.error ("expected Association "^xmiid^" in table (in find_association_name)")

fun insert_constraint table (c:XMI.Constraint) =
    HashTable.insert table (#xmiid c, Constraint c)

fun insert_variable_dec table (v:XMI.VariableDeclaration) =
    HashTable.insert table (#xmiid v, Variable v)

fun insert_stereotype table (s:XMI.Stereotype) =
    HashTable.insert table (#xmiid s, Stereotype (#name s))

fun insert_generalization table (g:XMI.Generalization) =
    HashTable.insert table (#xmiid g, Generalization (#child_id g, #parent_id g))

fun insert_attribute table path_prefix (a:XMI.Attribute) =
    HashTable.insert table (#xmiid a, Attribute (path_prefix @ [#name a]))

fun insert_operation table path_prefix (a:XMI.Operation) =
    HashTable.insert table (#xmiid a, Operation (path_prefix @ [#name a]))

fun add_aend table xmiid (aend:Rep.associationend) = () (* FIX *)

fun insert_state table (XMI.CompositeState st) =
    (List.app (insert_state table) (#subvertex st);
    HashTable.insert table (#xmiid st, State (XMI.CompositeState st)))
  | insert_state table (XMI.SubactivityState st) =
    (List.app (insert_state table) (#subvertex st);
    HashTable.insert table (#xmiid st, State (XMI.SubactivityState st)))
  | insert_state table (st:XMI.StateVertex) = 
    HashTable.insert table (XMI.state_xmiid_of st, State st)
    
fun insert_event table (e as XMI.CallEvent ev) =
    HashTable.insert table (#xmiid ev, Event e)
  | insert_event  table (e as XMI.SignalEvent ev) =
    HashTable.insert table (#xmiid ev, Event e)

fun insert_transition table (XMI.mk_Transition trans) =
    HashTable.insert table (#xmiid trans, Transition (XMI.mk_Transition trans))

fun insert_activity_graph table (XMI.mk_ActivityGraph ag) =
    let val context = #contextxmiid ag 
    in  
	(case valOf (HashTable.find table context) 
	  of (Type (c,xs,assocs,ac,ags))  => HashTable.insert 
						 table (context, Type (c,xs,assocs,ac,
XMI.mk_ActivityGraph ag::ags))
	   | _                => raise Option) 
	      handle Option => Logger.error ("expected Type "^context^" in table (insert_activity_graph)");
	List.app (insert_transition table) (#transitions ag);
	insert_state table (#top ag)
    end

fun insert_dependency table dep =
    HashTable.insert table (#xmiid dep, Dependency dep)

fun insert_tagdefinition table (td:XMI.TagDefinition) =
    HashTable.insert table (#xmiid td, TagDefinition (#name td))

fun insert_classifierInState table cls_id cis_id =
    HashTable.insert table (cis_id,ClassifierInState cls_id)

(** insert an association into the hashtable *)
fun insert_association table package_prefix (association:XMI.Association) = 
    let 
	val _ = Logger.debug2 ("Xmi_IDTable.insert_association\n")
	val id      = #xmiid association
	val name    = #name association
	val path    = if (isSome name) then package_prefix@[valOf name]
		      else package_prefix@["association_"^(next_unique_name table)]
	val res = HashTable.insert table (id,Association(path,association))
	val _ = Logger.debug2  ("Xmi_IDTable.insert_association\n")
    in
	res
	
    end


fun insert_classifier table package_prefix class = 
    let val _ = Logger.debug2 ("Xmi_IDTable.insert_classifier\n")
	val id      = XMI.classifier_xmiid_of class
	val name    = XMI.classifier_name_of class
	val path    = package_prefix @ [name]
		      
	fun argoUMLWorkaround name = (* ugly hack *) 
	    let
	      val _ = Logger.warn ("Warning: argument ("^name
			     ^") is not a collection value,\n"
			     ^"assuming ArgoUML workaround for supporting collection types ...")
	      val [colType,elementtype,tail] = String.fields (fn c => c = #"(" orelse c= #")") name
		  handle _ =>  ["","",""]
	    in 
	      if elementtype = "" 
	      then NONE 
	      else SOME (Rep_OclType.Classifier (String.fields (fn c => #"."  = c) elementtype))
	    end  
	    
	val ocltype = if (package_prefix = ["oclLib"]
			  orelse package_prefix = ["UML_OCL"])
		      then if      name = "Integer" then Rep_OclType.Integer
			   else if name = "Boolean" then Rep_OclType.Boolean
			   else if name = "String"  then Rep_OclType.String
			   else if name = "Real"    then Rep_OclType.Real
			   else if name = "OclVoid" then Rep_OclType.OclVoid
                           (* this shouldn't be necessary: *) 
			   else if name = "Void"    then Rep_OclType.OclVoid 
			   else if name = "OclAny"  then Rep_OclType.OclAny
			   (* now this is really ugly... *)
			   else if String.isPrefix "Collection(" name 
			   then Rep_OclType.Collection (Rep_OclType.Classifier [
							XMI.classifier_elementtype_of class])
				handle ex => case argoUMLWorkaround name of 
					      SOME c => Rep_OclType.Collection (c)
					    | NONE => raise ex
			   else if String.isPrefix "Sequence("   name 
			   then Rep_OclType.Sequence   (Rep_OclType.Classifier [
							XMI.classifier_elementtype_of class])
				handle ex => case argoUMLWorkaround name of 
					      SOME c => Rep_OclType.Sequence c
					    | NONE => raise ex
			   else if String.isPrefix "Set("        name 
			   then Rep_OclType.Set        (Rep_OclType.Classifier [
							XMI.classifier_elementtype_of class])
				handle ex => case argoUMLWorkaround name of 
					      SOME c => Rep_OclType.Set c
					    | NONE => raise ex
			   else if String.isPrefix "Bag("        name 
			   then Rep_OclType.Bag        (Rep_OclType.Classifier [
							XMI.classifier_elementtype_of class])
				handle ex => case argoUMLWorkaround name of 
					      SOME c => Rep_OclType.Bag c
					    | NONE => raise ex
			   else if String.isPrefix "OrderedSet(" name 
			   then Rep_OclType.OrderedSet (Rep_OclType.Classifier [
							XMI.classifier_elementtype_of class])
				handle ex => case argoUMLWorkaround name of 
					      SOME c => Rep_OclType.OrderedSet c
					    | NONE => raise ex
			   else Logger.error ("didn't recognize ocltype "^name) 
		      else Rep_OclType.Classifier path
	(* This function is called before the associations are handled, *)
	(* so we do not have to take care of them now...                *)
	val assocs = nil 
	(* The association denoted by an association class, however, is *)
	(* known at this time *)
	val (acAssoc,acPath) = case class of
				   XMI.AssociationClass c => 
				   let 
				       val acAssocName =  name^"_association_"^(next_unique_name table)
				       val acAssoc = {xmiid = id^"_association",
						      name = SOME acAssocName,
						      connection = #connection c}:XMI.Association
				   in
				       ([acAssoc],package_prefix @[acAssocName])
				   end
				 | _ => ([],[])
	val ag    = nil
	val res = 
	    let
		val _ = HashTable.insert table (id,Type (ocltype,assocs,acPath,class,ag))
	    in
		(case class 
		  of XMI.Class c => (Logger.debug2 "insert_classifier: Class\n";
				     List.app (insert_attribute table path) (#attributes c);
				     List.app (insert_operation table path) (#operations c);
				     List.app (insert_classifierInState table id) (#classifierInState c);
				     ())
		   | XMI.Primitive c => (List.app (insert_operation table path) (#operations c); ())
		   | XMI.Enumeration c => (List.app (insert_operation table path) (#operations c); ())
		   | XMI.Interface c => (List.app (insert_operation table path) (#operations c); ())
		   | XMI.Collection c => (List.app (insert_operation table path) (#operations c); ())
		   | XMI.Sequence c => (List.app (insert_operation table path) (#operations c); ())
		   | XMI.Set c => (List.app (insert_operation table path) (#operations c); ())
		   | XMI.Bag c => (List.app (insert_operation table path) (#operations c); ())
		   | XMI.OrderedSet c => (List.app (insert_operation table path) (#operations c); ())
		   | XMI.AssociationClass c => (Logger.debug2 "insert_classifier: AssociationClass\n";
						List.app (insert_attribute table path) (#attributes c);   
						List.app (insert_operation table path) (#operations c);              
						List.app (insert_classifierInState table id) [];
						insert_association table package_prefix (hd acAssoc);
						()
					       )
		   | _ => ()
		)
	    end
	val _ = Logger.debug2 ("end Xmi_IDTable.insert_classifier \n")
    in
	res
    end
    
    
(* recursively insert mapping of xmi.id's to model elements into Hashtable *)
fun insert_package table package_prefix (XMI.Package p) =
    let
	val _ = Logger.debug2 ("Xmi_IDTable.insert_package\n")
	val full_name = package_prefix @ [#name p]
	val res = 
	    let
		val _ = List.app (insert_generalization table)           (#generalizations p)
		val _ = Logger.debug3 "insert_package: constraints\n"
		val _ = List.app (insert_constraint     table)           (#constraints p)
		val _ = Logger.debug3 "insert_package: stereotypes\n"
		val _ = List.app (insert_stereotype     table)           (#stereotypes p)
		val _ = Logger.debug3 "insert_package: classifiers\n"
		val _ = List.app (insert_classifier     table full_name) (#classifiers p)
		val _ = Logger.debug3 "insert_package: associations\n"
		val _ = List.app (insert_association    table full_name) (#associations p)
		val _ = Logger.debug3 "insert_package: packages\n"
		val _ = List.app (insert_package        table full_name) (#packages p)
		val _ = Logger.debug3 "insert_package: activity_graphs\n"
		val _ = List.app (insert_activity_graph table)           (#activity_graphs p)
		val _ = Logger.debug3 "insert_package: dependencies\n"
		val _ = List.app (insert_dependency     table)           (#dependencies p)
		val _ = Logger.debug3 "insert_package: tag defenitions\n"
		val _ = List.app (insert_tagdefinition  table)           (#tag_definitions p)
		val _ = Logger.debug3 "insert_package: events\n"
		val _ = List.app (insert_event          table)           (#events p)
		val _ = Logger.debug3 "insert_package: insert package\n"
	    in
		HashTable.insert table (#xmiid p,Package full_name)
	    end
	val _ = Logger.debug2 ("Xmi_IDTable.insert_package \n")
    in
	res
    end 
    
(* We do not want the name of the model to be part of the package hierarchy, *)
(* therefore we handle the top-level model seperately                        *)
fun insert_model table (XMI.Package p) = 
    let 
	val _ = Logger.debug2 ("insert_model\n")
	val full_name = nil
	val res = 
	    let
		val _ = List.app (insert_generalization table)           (#generalizations p)
		val _ = List.app (insert_constraint     table)           (#constraints p)
		val _ = List.app (insert_stereotype     table)           (#stereotypes p)
		val _ = List.app (insert_classifier     table full_name) (#classifiers p)
		val _ = List.app (insert_association    table full_name) (#associations p)
		val _ = List.app (insert_package        table full_name) (#packages p)
		val _ = List.app (insert_activity_graph table)           (#activity_graphs p)
		val _ = List.app (insert_dependency     table)           (#dependencies p)
		val _ = List.app (insert_tagdefinition  table)           (#tag_definitions p)
		val _ = List.app (insert_event          table)           (#events p)
	    in
		HashTable.insert table (#xmiid p,Package full_name)
	    end
	val _ = Logger.debug2 ("Xmi_IDTable.insert_model\n")
    in
	res
    end 


fun initial_state_of table (XMI.mk_ActivityGraph ag) = 
    valOf (List.find (fn (XMI.PseudoState{kind,...})  => kind = XMI.initial
		       | _ => false) 
		     (XMI.state_subvertices_of (#top ag)))


fun successor_states_of table (st:XMI.StateVertex) =
    map  ((find_state table) o  XMI.transition_target_of o 
	  (find_transition table)) 
	 (XMI.state_outgoing_trans_of st)   

(* returns a list of tag-value pairs *)
fun class_taggedvalues_of table (XMI.Class c) = 
    map (fn x => (find_tagdefinition table (#tag_type x),#dataValue x)) 
	(#taggedValue c)
  | class_taggedvalues_of table (XMI.AssociationClass c) = 
    map (fn x => (find_tagdefinition table (#tag_type x),#dataValue x)) 
	(#taggedValue c)
  | class_taggedvalues_of table (XMI.Primitive c) =
    map (fn x => (find_tagdefinition table (#tag_type x),#dataValue x))
        (#taggedValue c)
  | class_taggedvalues_of table _ = Logger.error "in class_taggedvalues_of: \
                                          \argument doesn't support tagged values"
	

(* returns the value of the given tag *)
fun class_taggedvalue_of table tag (XMI.Class c) =
    Option.map #2 ((List.find (fn (x,y) => x=tag)) 
		       (class_taggedvalues_of table (XMI.Class c)))
  | class_taggedvalue_of table tag (XMI.AssociationClass c) =
    Option.map #2 ((List.find (fn (x,y) => x=tag)) 
		       (class_taggedvalues_of table (XMI.AssociationClass c)))
  | class_taggedvalue_of table tag (XMI.Primitive c) =
    Option.map #2 ((List.find (fn (x,y) => x=tag))
                       (class_taggedvalues_of table (XMI.Primitive c)))
  | class_taggedvalue_of table tag _ = Logger.error "in class_taggedvalues_of: \
                                             \argument doesn't support tagged values"
	

(* returns a list of tag-value pairs *)
fun attribute_taggedvalues_of table (a:XMI.Attribute) = 
    map (fn x => (find_tagdefinition table (#tag_type x),#dataValue x)) 
	(#taggedValue a)
 

(* returns the value of the given tag *)
fun attribute_taggedvalue_of table tag (a:XMI.Attribute) =
    Option.map #2 ((List.find (fn (x,y) => x=tag)) 
		       (attribute_taggedvalues_of table a))
	

(* returns a list of tag-value pairs *)
fun state_taggedvalues_of table st = 
    map (fn x => (find_tagdefinition table (#tag_type x),#dataValue x)) 
	(XMI.state_taggedValue_of st)

(* returns the value of the given tag *)
fun state_taggedvalue_of table tag st =
    Option.map #2 ((List.find (fn (x,y) => x=tag)) 
		       (state_taggedvalues_of table st))
    

(* returns a list of tag-value pairs *)
fun package_taggedvalues_of table (XMI.Package p) = 
    map (fn x => (find_tagdefinition table (#tag_type x),#dataValue x)) 
	(#taggedValue p)

(* returns the value of the given tag *)
fun package_taggedvalue_of table tag (XMI.Package p) =
    Option.map #2 ((List.find (fn (x,y) => x=tag)) 
		       (package_taggedvalues_of table (XMI.Package p)))
    

(* check whether a class has the given stereotype *)
fun classifier_has_stereotype t st c = 
    List.exists (fn x => (find_stereotype t x) = st) 
		(XMI.classifier_stereotype_of c)


fun fix_associationend t (assoc_path:Rep_OclType.Path) (aend:XMI.AssociationEnd) =
    let	
	val id = #xmiid aend
	val participant_id = #participant_id aend
	val (cls_type,assocs,assoc,cls,ags)  = find_classifier_entries t participant_id
        val name = Option.getOpt(#name aend,
				 (StringHandling.uncapitalize o XMI.classifier_name_of o
				  find_classifier t) participant_id)
    in 
	((if not (List.exists (fn x => x = assoc_path) assocs) then 
	    (* add the association to the participant *)
	    (HashTable.insert t (participant_id, Type (cls_type,assoc_path::assocs,assoc,cls,ags)))
	  else 
	      ());
         HashTable.insert t (#xmiid aend, AssociationEnd (List.concat [assoc_path, [name]], aend)))
    end

(** 
 * This handles only regular associations. An association class's belonging
 * association is handled at insert_classifier. However, the normal classes
 * that part of that association class's association still need to add the 
 * association to their list of associations.
 * Traverse the list of aends and update all listed classifiers with the path
 * of the current association.
 *)
fun fix_association t (assoc as {xmiid,name,connection}:XMI.Association) =
    let
	fun updateTableEntry t pathUpdate typeId =
	    let
		val (oclType,associations,association,class,ag) = find_type t typeId
		(* prefix version refused to work *)
		fun existsPath assocList = List.exists (fn x => x=pathUpdate) assocList
		val modifiedAssociations = if(existsPath associations)
					   then
					       associations
					   else
					       pathUpdate::associations					       					       
	    in
		HashTable.insert t (typeId,Type(oclType,modifiedAssociations,association,class,ag))
	    end
	val assocPath = find_association_path t xmiid
	val participantIds = map (#participant_id) connection
    in
	List.app (updateTableEntry t assocPath) participantIds
    end

fun fixAssociationFromAsssociationClass table (XMI.AssociationClass{xmiid,
								    ...}) =
    let
	val association = find_association table (xmiid ^ "_association")
    in
	fix_association table association
    end

(** 
 * Handel the broken association references, meaning updating the 
 * association path list for classes and association classes.
 * Since classifiers do not store their belonging aends, we traverse the 
 * associations: 
 *         We skip the aends and instead process the set of associations. For
 *         each association, we traverse the connection part and search for 
 *         the classifier listed as participant_id. Then we simply add the 
 *         association path to the found classifier.
 * For the classifiers part of an association class's class, no association
 * construct is present in the package p, while those constructs are already
 * in the hashtable. To traverse them as well, we extract all association
 * classes and reconstruct the associations.
 *)
fun fix_associations t (XMI.Package p) =
    let
	    val associationClasses = filter (fn (XMI.AssociationClass x) => true
					                              | _ => false) (#classifiers p)
    in
	    (* All association ends are stored in associations, so we will 
	     * traverse them an update affected Classes and AssociationClasses *)
	     (List.app (fix_associations t) (#packages p);
	      List.app (fix_association t) (#associations p);
	      List.app (fixAssociationFromAsssociationClass t) associationClasses)
    end


end