(***************************************************************************** * su4sml --- an SML repository for managing (Secure)UML/OCL models * http://projects.brucker.ch/su4sml/ * * rep_core.sml --- core repository datastructures for su4sml * 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$ *) (** Repository datatypes and helper functions for classifiers. *) signature REP_CORE = sig type Scope type Visibility type operation = { name : string, precondition : (string option * Rep_OclTerm.OclTerm) list, postcondition : (string option * Rep_OclTerm.OclTerm) list, body : (string option * Rep_OclTerm.OclTerm) list, arguments : (string * Rep_OclType.OclType) list, result : Rep_OclType.OclType, isQuery : bool, scope : Scope, stereotypes : string list, visibility : Visibility } type associationend= { name: Rep_OclType.Path (* pathOfAssociation@[role]*), aend_type : Rep_OclType.OclType (* participant type *), multiplicity: (int * int) list, ordered: bool, visibility: Visibility, init: Rep_OclTerm.OclTerm option } type attribute = { name : string, attr_type : Rep_OclType.OclType, visibility : Visibility, scope: Scope, stereotypes: string list, init : Rep_OclTerm.OclTerm option } type association = { name: Rep_OclType.Path (* pathOfPackage@[assocName] *), aends: associationend list, qualifiers: (string * attribute list) list (*(aend name, qualifiers)*), aclass: Rep_OclType.Path option } type constraint = (string option * Rep_OclTerm.OclTerm) datatype Classifier = Class of { name : Rep_OclType.OclType, parent : Rep_OclType.OclType option, attributes : attribute list, operations : operation list, associations: Rep_OclType.Path list (* associations *), invariant : (string option * Rep_OclTerm.OclTerm) list, stereotypes : string list, interfaces : Rep_OclType.OclType list, thyname : string option, visibility : Visibility, activity_graphs : Rep_ActivityGraph.ActivityGraph list } | AssociationClass of { name : Rep_OclType.OclType, parent : Rep_OclType.OclType option, attributes : attribute list, operations : operation list, invariant : (string option * Rep_OclTerm.OclTerm) list, stereotypes : string list, interfaces : Rep_OclType.OclType list, thyname : string option, activity_graphs : Rep_ActivityGraph.ActivityGraph list, associations: Rep_OclType.Path list, visibility : Visibility, association: Rep_OclType.Path } | Interface (* not supported yet *) of { name : Rep_OclType.OclType, parents : Rep_OclType.OclType list, operations : operation list, stereotypes : string list, invariant : (string option * Rep_OclTerm.OclTerm) list, thyname : string option } | Enumeration (* not really supported yet? *) of { name : Rep_OclType.OclType, parent : Rep_OclType.OclType option, operations : operation list, literals : string list, invariant : (string option * Rep_OclTerm.OclTerm) list, stereotypes : string list, interfaces : Rep_OclType.OclType list, thyname : string option } | Primitive (* not really supported yet *) of { name : Rep_OclType.OclType, parent : Rep_OclType.OclType option, operations : operation list, associations: Rep_OclType.Path list, invariant : (string option * Rep_OclTerm.OclTerm) list, stereotypes : string list, interfaces : Rep_OclType.OclType list, thyname : string option } | Template of { parameter : Rep_OclType.OclType, classifier : Classifier } type transform_model = (Classifier list * association list) (***************************************** * MODEL * *****************************************) (** * TODO: Description *) val union : transform_model -> transform_model -> transform_model val intersection : transform_model -> transform_model -> transform_model val minus : transform_model -> transform_model -> transform_model val isDisjunct : transform_model -> transform_model -> bool val toString : transform_model -> string val rmDuplicates : transform_model -> transform_model (** * TODO: Description *) val normalize_ext : transform_model -> transform_model (** * TODO: Description *) val normalize : association list -> Classifier -> Classifier (** * TODO: Description *) val normalize_init : Classifier -> Classifier (** * Update the thy_name of a classifier. *) val update_thyname : string -> Classifier -> Classifier (** * Update the classifier wiht new invariants. *) val update_invariant : (string option * Rep_OclTerm.OclTerm) list -> Classifier -> Classifier (** * Update the classifier with new operations. *) val update_operations : operation list -> Classifier -> Classifier (** * Update the classifier with a new invariant. *) val addInvariant : constraint -> Classifier -> Classifier (** * Update the classifier with new invariants. *) val addInvariants: constraint list -> Classifier -> Classifier (** * Update the classifier with a new operations *) val addOperation : operation -> Classifier -> Classifier (** * Sort the classifier according to its names. *) val topsort_cl : Classifier list -> Classifier list (** * TODO: Description *) val connected_classifiers_of : association list -> Classifier -> Classifier list -> Classifier list (***************************************** * CLASSIFIERS * *****************************************) (** * Ocl Classifier OclAny. *) val OclAnyC : Classifier (** * Returns the classifier of a given path. *) val class_of : Rep_OclType.Path -> transform_model -> Classifier (** * Is the classifier originally of the design model. * Classes of the design models are classes which are wether templates * nor oclLib classes. *) val class_of_design_model : Rep_OclType.Path -> transform_model -> Classifier (** * Returns the classifier of a given type. *) val class_of_type : Rep_OclType.OclType -> transform_model -> Classifier (** * Returns the classifier of a given term. *) val class_of_term : Rep_OclTerm.OclTerm -> transform_model -> Classifier (** * Returns the classifier of the parent of a classifier. *) (* val class_of_parent : Classifier -> transform_model -> Classifier *) (** * Returns all classifiers of a given package. *) val classes_of_package : Rep_OclType.Path -> transform_model -> Classifier list (** * Returns paths of the associations of a classifier. *) val associations_of : Classifier -> Rep_OclType.Path list (** * Returns the invariants of an operation. *) val invariant_of : Classifier -> (string option * Rep_OclTerm.OclTerm) list (** * Get the stereotypes of a classifier. *) val stereotypes_of : Classifier -> string list (** * Is the classifier visible? *) val is_visible_cl : Classifier -> bool (** * Visibility of classifier *) val visibility_of : Classifier -> Visibility (***************************************** * TYPES * *****************************************) val string_to_type : string -> Rep_OclType.OclType (** * Returns the type of a classifier. *) val type_of : Classifier -> Rep_OclType.OclType (** * Returns the type of the parent from a * classifier. *) val type_of_parent : Classifier -> Rep_OclType.OclType (** * Returns the type of all parents of a classifier. *) val type_of_parents : Classifier -> transform_model -> Rep_OclType.OclType list (** * Returns the type of a given term. *) val type_of_term : Rep_OclTerm.OclTerm -> Rep_OclType.OclType (** * Returns the type of a given CollectionPart. *) val type_of_CollPart : Rep_OclTerm.CollectionPart -> Rep_OclType.OclType (** * Returns the type of a given simple Path. * DO NOT USE: just for parsing where the model is not available. *) val simple_type_of_path : Rep_OclType.Path -> Rep_OclType.OclType (** * Returns the type of a given Path *) val type_of_path : Rep_OclType.Path -> transform_model -> Rep_OclType.OclType (** * returns the type of the classifier this association end belongs to. * params {aend} * @param aend association end * @return type of the classifier at the association end *) val type_of_aend : associationend -> Rep_OclType.OclType (** * Returns the type of the attribute. *) val type_of_att : attribute -> Rep_OclType.OclType (** * Returns the type of a not yet instantiate template *) val type_of_template : Classifier -> Rep_OclType.OclType (** * Get type of template parameter. *) val type_of_template_parameter : Rep_OclType.OclType -> Rep_OclType.OclType (** * Replace the template parameter with another type. *) val substitute_templ_para : Rep_OclType.OclType -> Rep_OclType.OclType -> Rep_OclType.OclType (** * Substitute a package name of a path. *) val substitute_package : Rep_OclType.Path -> Rep_OclType.Path -> Rep_OclType.Path -> Rep_OclType.Path (** * Prefixes a type with a given package name. *) val prefix_type : string list -> Rep_OclType.OclType -> Rep_OclType.OclType (** * Prefix a given path with a prefix. *) val prefix_path : string list -> string list -> string list (** * Collections of Collections are flattened according to Ocl 2.0 Standard. *) val flatten_type : Rep_OclType.OclType -> Rep_OclType.OclType (** * Dispatch a collection. *) val create_set : (string * Rep_OclType.OclType) -> Rep_OclType.OclType (** * Get the type if the associationend would be a attribute. *) val convert_aend_type : associationend -> Rep_OclType.OclType (** * Are two types equal? *) val type_equals : Rep_OclType.OclType -> Rep_OclType.OclType -> bool (** * Is first type conform to the second type? *) val conforms_to : Rep_OclType.OclType -> Rep_OclType.OclType -> transform_model -> bool (** * OBSOLETE *) val correct_type_for_CollLiteral : Rep_OclType.OclType -> Rep_OclTerm.CollectionPart -> bool (** * Type a collection type? *) val isColl_Type : Rep_OclType.OclType -> bool (** * Type a value (basic) type? *) val isValueType : Rep_OclType.OclType -> bool (***************************************** * TERMS/EXPRESSIONS * *****************************************) (** * Upcast an OclTerm. *) val upcast : (Rep_OclTerm.OclTerm * Rep_OclType.OclType) -> Rep_OclTerm.OclTerm (** * Upcast the types of an operation according to another operation, if possible. *) val upcast_op : (Classifier * operation) list -> Rep_OclTerm.OclTerm -> (Rep_OclTerm.OclTerm * Rep_OclType.OclType) list -> transform_model -> Rep_OclTerm.OclTerm (** * *) val upcastable_args : (string * Rep_OclType.OclType) list -> (Rep_OclTerm.OclTerm * Rep_OclType.OclType) list -> transform_model -> bool (** * Interfere the types of the arguments of an operation according to * a given signature, if possible. *) val upcast_args : (string * Rep_OclType.OclType) list -> (Rep_OclTerm.OclTerm * Rep_OclType.OclType) list -> transform_model -> (Rep_OclTerm.OclTerm * Rep_OclType.OclType) list (** * *) val upcast_type : Rep_OclType.OclType -> Rep_OclType.OclType -> transform_model -> Rep_OclType.OclType (** * Upcast the types of an attribute to an other attribute, if possible. *) val upcast_att : (Classifier * attribute) -> Rep_OclTerm.OclTerm -> transform_model -> Rep_OclTerm.OclTerm option (** * Upcast the types of an association to an other association, if possible. *) val upcast_aend : (Classifier * associationend) -> Rep_OclTerm.OclTerm -> transform_model -> Rep_OclTerm.OclTerm option (** * Upcast the types of an assoc/attribute to an other assoc/attribute, if possible. *) val upcast_att_aend : (Classifier * attribute option * associationend option) list -> Rep_OclTerm.OclTerm -> transform_model -> Rep_OclTerm.OclTerm (** * Prefixes all types in a term with the * given string list. *) val prefix_expression : string list -> Rep_OclTerm.OclTerm -> Rep_OclTerm.OclTerm (** * Prefix all types in a CollectionPart with * the given string list. *) val prefix_collectionpart : string list -> Rep_OclTerm.CollectionPart -> Rep_OclTerm.CollectionPart (** * Checks if a term is side-effect free. This means that just operationcalls to * operations with the attribute isQuery=true are allowed. *) val side_effect_free : Rep_OclTerm.OclTerm -> transform_model -> bool (** * Checks if a collection part is side-effect free. This means that jus operationcalls to * operations with the attribute isQuery=true are allowed. *) val collparts_are_side_effect_free : Rep_OclTerm.CollectionPart-> transform_model -> bool (***************************************** * OPERATIONS * *****************************************) val operation_of : transform_model -> Rep_OclType.Path -> operation option (** * Find an operation in a list of operations. *) val get_operation : string -> Classifier -> transform_model -> operation (** Get the local operations of a classifier.*) val local_operations_of : Classifier -> operation list (** Get the redefined/refined operations of a classifier.*) val modified_operations_of : Classifier -> transform_model -> operation list (** Get all the inherited (without the redefined ones) operations of a classifier.*) val inherited_operations_of : Classifier -> transform_model -> operation list (** Get all operations of a classifier (for redefined ones the more special is choosen).*) val all_operations_of : Classifier -> transform_model -> operation list (** Get all creators of a classifier.*) val creation_operations_of : Classifier -> transform_model -> operation list (** Get all destroying operations of a classifier.*) val destruction_operations_of : Classifier -> transform_model -> operation list (** Get all public operations of a classifier.*) val public_operations_of : Classifier -> transform_model -> operation list (** Get all private operations of a classifier.*) val private_operations_of : Classifier -> transform_model -> operation list (** Get all package operations of a classifier.*) val package_operations_of : Classifier -> transform_model -> operation list (** Get all protected operations of a classifier.*) val protected_operations_of : Classifier -> transform_model -> operation list (** Get all query operations of a classifier.*) val query_operations_of : Classifier -> transform_model -> operation list (** Get all command operations of a classifier.*) val command_operations_of : Classifier -> transform_model -> operation list (** Get the local invariants of a classifier.*) val local_invariants_of : Classifier -> (string option * Rep_OclTerm.OclTerm) list (** Get the inherited invarinats of a classifier.*) val inherited_invariants_of : Classifier -> transform_model -> (string option * Rep_OclTerm.OclTerm) list (** Get all invariants of a classifier.*) val all_invariants_of : Classifier -> transform_model -> (string option * Rep_OclTerm.OclTerm) list (** OBSOLETE **) val operations_of : Classifier -> operation list (** OBSOLETE **) val get_overloaded_methods : Classifier -> string -> transform_model -> (Classifier * operation) list (** OBSOLETE **) val get_meth : Rep_OclTerm.OclTerm -> string -> (Rep_OclTerm.OclTerm * Rep_OclType.OclType) list -> transform_model -> Rep_OclTerm.OclTerm (** * Return the next parent which is implementing the operation. *) val last_implementation_of_op : Classifier -> string -> transform_model -> (Classifier * operation) (** * Returns the preconditions of an operation. *) val precondition_of_op : operation -> (string option * Rep_OclTerm.OclTerm) list (** * Returns the postconditions of an operation. *) val postcondition_of_op : operation -> (string option * Rep_OclTerm.OclTerm) list (** * Returns the body of an operation. *) val body_of_op : operation -> (string option * Rep_OclTerm.OclTerm) list (** * Returns the arguments of an operation. *) val arguments_of_op : operation -> (string * Rep_OclType.OclType) list (** * Returns the result type of an operation. *) val result_of_op : operation -> Rep_OclType.OclType (** * Returns the name (string) of an operation. *) val name_of_op : operation -> string (** * Is the operation visible? *) val is_visible_op : operation -> bool (** * TODO: Description *) val mangled_name_of_op : operation -> string (** * Update an operation with new preconditions. *) val update_precondition : (string option * Rep_OclTerm.OclTerm) list -> operation -> operation (** * Update an operation with new postconditions. *) val update_postcondition : (string option * Rep_OclTerm.OclTerm) list -> operation -> operation (***************************************** * ATTRIBUTES * *****************************************) (** * Get name of attribute *) val name_of_att : attribute -> string (** * Get the local attributes of a classifier. *) val local_attributes_of : Classifier -> attribute list (** * Get the inherited attributes of a classifier. *) val inherited_attributes_of : Classifier -> transform_model -> attribute list (** * Get all the attributes of a Classifier (including the inherited ones). *) val all_attributes_of : Classifier -> transform_model -> attribute list (** * Get all the overriden attributes of a Classifier (Note: this attributes are inherently * all local. *) val modified_attributes_of : Classifier -> transform_model -> attribute list (** * Find an attribute in a list of attributes. *) val get_attribute : string -> attribute list -> attribute option (** OBSOLETE **) val attributes_of : Classifier -> attribute list (** OBSOLETE **) val get_overloaded_attrs_or_assocends : Classifier -> string -> transform_model -> (Classifier * attribute option * associationend option) list (** OBSOLETE **) val get_attr_or_assoc : Rep_OclTerm.OclTerm -> string -> transform_model -> Rep_OclTerm.OclTerm (** * convert an associationend into an attribute. *) val convert_aend : string -> associationend -> attribute (** * Is the attribute visible? *) val is_visible_attr : attribute -> bool (***************************************** * ASSOCIATIONENDS * *****************************************) (** * TODO: Description *) val associationends_of: association list -> Classifier -> associationend list val inherited_associationends_of : Classifier -> transform_model -> associationend list val local_associationends_of : association list -> Classifier -> associationend list val all_associationends_of : Classifier -> transform_model -> associationend list (** * Returns ends of an association. *) val aends_of_association: association -> associationend list (** * returns all associationends belonging to associationPath, excluding the * associationend at source. * @params {source,associations,associationPath} *) val oppositeAendsOfAssociation: Rep_OclType.OclType -> association list -> Rep_OclType.Path -> associationend list (** * Does the opposite of oppositeAendsOfAssociation above. Returns only the * associationends belonging to source. * @params {source,associations,associationPath} *) val incomingAendsOfAssociation: Rep_OclType.OclType -> association list -> Rep_OclType.Path -> associationend list (***************************************** * PARENTS [ OK ] * *****************************************) (** * Returns the classifier of the parent of classifier. *) val parent_of : Classifier -> transform_model -> Classifier (** * Returns all parents of a classifier. *) val parents_of : Classifier -> transform_model -> Classifier list (** * Returns one of the parents from the classifier. *) val parent_name_of : Classifier -> Rep_OclType.Path (** * Returns the name of the package from the * parent class. *) val parent_package_of : Classifier -> Rep_OclType.Path (** * Returns the last part (last string in path) of the name * of the parent of the classifier. *) val parent_short_name_of : Classifier -> string (** * Returns the types of the interfaces from * the classifier. *) val parent_interfaces_of : Classifier -> Rep_OclType.OclType list (** * Returns the names of the interfaces from the * parents. *) val parent_interface_names_of : Classifier -> Rep_OclType.Path list (***************************************** * SIGNATURES * *****************************************) (** * Prefixes all types in the signature with a * given string list. *) val prefix_signature : string list -> (string * Rep_OclType.OclType) list -> (string * Rep_OclType.OclType) list (** * Test wheter the signatures are type consistent. *) val sig_conforms_to : (string * Rep_OclType.OclType) list -> (string * Rep_OclType.OclType) list -> transform_model -> bool (***************************************** * RETURN Path/string * *****************************************) (** * Returns the name of the classifier. *) val name_of : Classifier -> Rep_OclType.Path (** * Returns the last part (last string in path) of * the name of the classifier. *) val short_name_of : Classifier -> string (** * Returns the thy_name of a classifer. *) val thy_name_of : Classifier -> string (** * Returns the name of the package. *) val package_of : Classifier -> Rep_OclType.Path (** * Returns all the packages of a model *) val all_packages_of_model : transform_model -> Rep_OclType.Path list (** * Returns the package name of the template parameter. *) val package_of_template_parameter : Rep_OclType.OclType -> string list (** * Path of the association. *) val path_of_association: association -> Rep_OclType.Path (** * Name of the association. *) val name_of_association: association -> Rep_OclType.Path (** * returns the association this association end belongs to. * @params {aend} * @param aend association end * @return the path of the enclosing association *) val association_of_aend : associationend -> Rep_OclType.Path (** * returns the name of the association end. The name of the association * end is the last part of the association end's path. * @params {aend} * @param aend association end * @return name of the association end as string. *) val name_of_aend : associationend -> string (** * Return the associationend as path *) val name_of_ae : associationend -> Rep_OclType.Path (** * returns the path of an association end. The path of an association end * is @[]. * @params {aend} * @param aend association end * @return path of association end *) val path_of_aend: associationend -> Rep_OclType.Path (** * TODO: Description *) val role_of_aend : associationend -> string (** * Convert Path(string list) into a string. *) val string_of_path : Rep_OclType.Path -> string (** * TODO: Description *) val short_name_of_path : Rep_OclType.Path -> string (***************************************** * RETURN activity_graphs * *****************************************) (** * TODO: Description *) val activity_graphs_of: Classifier -> Rep_ActivityGraph.ActivityGraph list (***************************************** * TEMPORARLY SIGNATURE, * PLEASE DELETE IF NOT DELETED YET. * JUST FOR DEBUGGING PROPOSES. *****************************************) val parse_string : char -> char list -> (char list * char list) exception InvalidArguments of string exception TemplateError of string exception TemplateInstantiationError of string exception GetClassifierError of string exception UpcastingError of string exception OperationNotFoundError of string exception AttributeNotFoundError of string exception NoParentForDatatype of string exception NoModelReferenced of string exception NoCollectionTypeError of Rep_OclType.OclType exception AttributeAssocEndNameClash of string exception ParentsOfError of string exception Rep_CoreError of string exception HOLOCL_ClassifierError of string end structure Rep_Core : REP_CORE = struct open Rep_Helper open Rep_OclTerm open Rep_OclType open XMI_DataTypes type Visibility = XMI_DataTypes.VisibilityKind type Scope = XMI_DataTypes.ScopeKind type operation = { name : string, precondition : (string option * Rep_OclTerm.OclTerm) list, postcondition : (string option * Rep_OclTerm.OclTerm) list, body : (string option * Rep_OclTerm.OclTerm) list, arguments : (string * Rep_OclType.OclType) list, result : Rep_OclType.OclType, isQuery : bool, scope : Scope, stereotypes : string list, visibility : Visibility } type associationend = { name : Rep_OclType.Path, aend_type : Rep_OclType.OclType, multiplicity : (int*int) list, visibility : Visibility, ordered : bool, init : Rep_OclTerm.OclTerm option } type attribute = { name : string, attr_type : Rep_OclType.OclType, visibility : Visibility, scope : Scope, stereotypes : string list, init : Rep_OclTerm.OclTerm option } type association = { name: Rep_OclType.Path, aends: associationend list, qualifiers: (string * attribute list) list, aclass: Rep_OclType.Path option } type constraint = (string option * Rep_OclTerm.OclTerm) datatype Classifier = Class of { name : Rep_OclType.OclType, parent : Rep_OclType.OclType option, attributes : attribute list, operations : operation list, associations: Rep_OclType.Path list, invariant : (string option * Rep_OclTerm.OclTerm) list, stereotypes : string list, interfaces : Rep_OclType.OclType list, thyname : string option, visibility : Visibility, activity_graphs : Rep_ActivityGraph.ActivityGraph list } | AssociationClass of { name : Rep_OclType.OclType, parent : Rep_OclType.OclType option, attributes : attribute list, operations : operation list, invariant : (string option * Rep_OclTerm.OclTerm) list, stereotypes : string list, interfaces : Rep_OclType.OclType list, thyname : string option, activity_graphs : Rep_ActivityGraph.ActivityGraph list, associations: Rep_OclType.Path list, visibility : Visibility, association: Rep_OclType.Path } | Interface of (* not supported yet *) { name : Rep_OclType.OclType, parents : Rep_OclType.OclType list, operations : operation list, stereotypes : string list, invariant : (string option * Rep_OclTerm.OclTerm) list, thyname : string option } | Enumeration of (* not really supported yet? *) { name : Rep_OclType.OclType, parent : Rep_OclType.OclType option, operations : operation list, literals : string list, invariant : (string option * Rep_OclTerm.OclTerm) list, stereotypes : string list, interfaces : Rep_OclType.OclType list, thyname : string option } | Primitive of (* not really supported yet *) { name : Rep_OclType.OclType, parent : Rep_OclType.OclType option, operations : operation list, associations: Rep_OclType.Path list, invariant : (string option * Rep_OclTerm.OclTerm) list, stereotypes : string list, interfaces : Rep_OclType.OclType list, thyname : string option } | Template of { parameter : Rep_OclType.OclType, classifier : Classifier } type transform_model = (Classifier list * association list) exception InvalidArguments of string exception TemplateError of string exception TemplateInstantiationError of string exception GetClassifierError of string exception UpcastingError of string exception NoParentForDatatype of string exception NoModelReferenced of string exception NoCollectionTypeError of Rep_OclType.OclType exception OperationNotFoundError of string exception AttributeNotFoundError of string exception AttributeAssocEndNameClash of string exception ParentsOfError of string exception Rep_CoreError of string exception HOLOCL_ClassifierError of string val OclLibPackage = "oclLib" val OclAnyC = Class{name=Rep_OclType.OclAny,parent=NONE,attributes=[], operations=[], interfaces=[], invariant=[(NONE,Literal("true",Boolean))],stereotypes=[], associations=[], thyname=NONE, visibility = public, activity_graphs=nil} val OclAnyAC = AssociationClass{name=Rep_OclType.OclAny,parent=NONE, attributes=[],operations=[], interfaces=[], invariant=[],stereotypes=[], associations=[], visibility = public, association= []:Path (*FIXME: sensible dummy*), thyname=NONE, activity_graphs=nil} fun type_of (Class{name,...}) = name | type_of (AssociationClass{name,...}) = name | type_of (Interface{name,...}) = name | type_of (Enumeration{name,...}) = name | type_of (Primitive{name,...}) = name | type_of (Template{classifier,...}) = type_of classifier fun type_of_term (Literal (s,typ)) = typ | type_of_term (Tuple(x)) = TupleType (List.map (fn (a,b,c) => (a,c)) x) | type_of_term (AttributeCall (t,typ,p,res_typ)) = res_typ | type_of_term (AssociationEndCall (t,typ,p,res_typ)) = res_typ | type_of_term (OperationCall (t,typ,p,l,res_typ)) = res_typ | type_of_term (Variable (s,typ)) = typ | type_of_term (CollectionLiteral (set,typ)) = typ | type_of_term (Iterator (_,_,_,_,_,_,res_typ)) = res_typ | type_of_term (If(_,_,_,_,_,_,res_typ)) = res_typ | type_of_term (OperationWithType (_,_,_,_,res_typ)) = res_typ | type_of_term (Let (_,_,_,_,_,res_typ)) = res_typ | type_of_term (Iterate (_,_,_,_,_,_,_,_,res_typ)) = res_typ | type_of_term (Predicate (_,_,_,_)) = Boolean fun name_of (Class{name,...}) = path_of_OclType name | name_of (AssociationClass{name,...}) = path_of_OclType name | name_of (Interface{name,...}) = path_of_OclType name | name_of (Enumeration{name,...}) = path_of_OclType name | name_of (Primitive{name,...}) = path_of_OclType name | name_of (Template{classifier,...}) = name_of classifier fun short_name_of_path p = (hd o rev) p fun name_of_op ({name,...}:operation) = name fun name_of_att ({name,...}:attribute) = name fun type_of_aend ({name,aend_type,...}:associationend) = aend_type fun name_of_aend ({name,aend_type,...}:associationend) = short_name_of_path name fun mangled_name_of_op ({name,arguments,result,...}:operation) = let val arg_typestrs = map (fn a => (Rep_OclType.string_of_OclType o #2 )a ) arguments in foldr1 (fn (a,b) =>(a^"_"^b)) ((name::arg_typestrs)@[Rep_OclType.string_of_OclType result]) end fun result_of_op ({result,...}:operation) = result fun arguments_of_op ({arguments,...}:operation) = arguments fun local_operations_of (Class{operations,...}) = operations | local_operations_of (AssociationClass{operations,...}) = operations | local_operations_of (Interface{operations,...}) = operations | local_operations_of (Enumeration{operations,...}) = operations | local_operations_of (Primitive{operations,...}) = operations | local_operations_of (Template{parameter,classifier}) = raise OperationNotFoundError ("..._operations_of a template not possible.\n") fun local_attributes_of (Class{attributes,...}) = attributes | local_attributes_of (AssociationClass{attributes,...}) = attributes | local_attributes_of (Interface{...}) = Logger.error "in Rep.local_attributes_of: argument is Interface" | local_attributes_of (Enumeration{...}) = Logger.error "in Rep.local_attributes_of: argument is Enumeration" | local_attributes_of (Primitive{...}) = [] | local_attributes_of (Template{parameter,classifier}) = raise AttributeNotFoundError ("..._attributes_of a template not possible.\n") fun operations_of class = local_operations_of class fun attributes_of class = local_attributes_of class fun class_of_design_model path (model as (clist,alist)) = let val _ = Logger.debug3 ("path of class = " ^ (String.concat (path)) ^ "\n") in if (List.hd (path) = "holOclLib") then raise HOLOCL_ClassifierError ("You try to access an HOLOCL Classifier "^(string_of_path path) ^" which is not part of the model.\n") else case (List.find (fn a => (type_of a) = Classifier (path)) clist) of NONE => raise GetClassifierError (String.concat path) | SOME(x) => x end fun type_of_parent (Class {parent,...}) = let val _ = Logger.debug4 ("type_of_parent : Class{parent,...} \n") in Option.valOf(parent) handle Option.Option => OclAny end | type_of_parent (AssociationClass {parent,...}) = let val _ = Logger.debug4 ("type_of_parent : AssociationClass{parent,...} \n") in Option.valOf(parent) handle Option.Option => OclAny end | type_of_parent (Primitive {parent, ...}) = Option.valOf(parent) | type_of_parent (Interface {parents, ...}) = (List.hd parents) | type_of_parent (Template{classifier,...}) = raise TemplateError ("Parent of a class can never be of type template(x).\n") (* RETURN: OclType list *) fun parse_string c ([]) = ([],[]) | parse_string c (h::tail) = if (c = h) then ([],h::tail) else (h::(#1 (parse_string c tail)),(#2 (parse_string c tail))) fun simple_type_of_path ["Integer"] = Integer | simple_type_of_path ["Boolean"] = Boolean | simple_type_of_path ["Real"] = Real | simple_type_of_path ["OclAny"] = OclAny | simple_type_of_path ["DummyT"] = DummyT | simple_type_of_path ["String"] = String | simple_type_of_path ["OclVoid"] = OclVoid | simple_type_of_path (("oclLib")::tail) = simple_type_of_path tail | simple_type_of_path [set] = if (List.exists (fn a => if (a = (#"(")) then true else false) (String.explode set)) then (* set *) let fun string_to_cons "Set" typ = Set(typ) | string_to_cons "Bag" typ = Bag(typ) | string_to_cons "Collection" typ = Collection (typ) | string_to_cons "OrderedSet" typ = OrderedSet (typ) | string_to_cons "Sequence" typ = Sequence (typ) val tokens = parse_string (#"(") (String.explode set) val cons = (#1 tokens) (* delete first "(" and last ")" element *) val tail = List.tl (real_path (#2 tokens)) val _ = TextIO.output(TextIO.stdOut,"tail "^ (String.implode tail) ^ "\n") in string_to_cons (String.implode cons) (simple_type_of_path ([String.implode tail])) end else Classifier([set]) | simple_type_of_path (list:Path) = Classifier (list) fun type_of_path ["Integer"] (model:transform_model) = Integer | type_of_path ["Boolean"] (model:transform_model) = Boolean | type_of_path ["Real"] (model:transform_model) = Real | type_of_path ["OclAny"] (model:transform_model) = OclAny | type_of_path ["DummyT"] (model:transform_model) = DummyT | type_of_path ["String"] (model:transform_model) = String | type_of_path ["OclVoid"] (model:transform_model) = OclVoid | type_of_path (("oclLib")::tail) (model:transform_model) = type_of_path tail model | type_of_path [set] (model:transform_model) = if (List.exists (fn a => if (a = (#"(")) then true else false) (String.explode set)) then (* set *) let fun string_to_cons "Set" typ = Set(typ) | string_to_cons "Bag" typ = Bag(typ) | string_to_cons "Collection" typ = Collection (typ) | string_to_cons "OrderedSet" typ = OrderedSet (typ) | string_to_cons "Sequence" typ = Sequence (typ) val tokens = parse_string (#"(") (String.explode set) val cons = (#1 tokens) (* delete first "(" and last ")" element *) val tail = List.tl (real_path (#2 tokens)) val _ = TextIO.output(TextIO.stdOut,"tail "^ (String.implode tail) ^ "\n") in string_to_cons (String.implode cons) (type_of_path ([String.implode tail]) model) end else let val cl = class_of_design_model [set] model in type_of cl end | type_of_path (list:Path) (model:transform_model) = let val cl = class_of_design_model list model in type_of cl end fun class_of_term source (c:Classifier list, a:association list) = let val typ = type_of_term (source) val _ = Logger.debug3 ("type_of_term term = " ^ (string_of_OclType typ) ^ "\n") fun class_of_t typ m = hd (List.filter (fn a => if ((type_of a) = typ) then true else false) m) fun substitute_classifier typ classifier = let fun substitute_args typ [] = [] | substitute_args typ ((s,t)::tail) = let val _ = Logger.debug4 ("substitute argument : " ^ (string_of_OclType typ) ^" template parameter of " ^ (string_of_OclType t) ^ " \n") in (s,substitute_typ typ t)::(substitute_args typ tail) end and substitute_parent (Collection(t)) typ = NONE | substitute_parent (Set(t)) typ = SOME(Collection(typ)) | substitute_parent (OrderedSet(t)) typ = SOME(Set(typ)) | substitute_parent (Bag(t)) typ = SOME(Collection(typ)) | substitute_parent (Sequence(t)) typ = SOME(Collection(typ)) | substitute_parent x typ = raise TemplateInstantiationError ("Parent tmpl type must be a collection.\n") and substitute_operations typ [] = [] | substitute_operations typ ((oper:operation)::tail) = let val _ = Logger.debug4 ("substitute operation : " ^ (#name oper) ^ " ... \n") val args = substitute_args typ (#arguments oper) val res = substitute_typ typ (#result oper) in ({ name = #name oper, postcondition = #postcondition oper, precondition = #precondition oper, body = #body oper, arguments = args, result = res, visibility = #visibility oper, isQuery = #isQuery oper, stereotypes = #stereotypes oper, scope = #scope oper }:operation)::(substitute_operations typ tail) end and substitute_typ typ templ_type = let val _ = Logger.debug4 ("substitute type : " ^ (string_of_OclType typ) ^ " instead of " ^ (string_of_OclType templ_type) ^ " \n") in case templ_type of (* innerst type *) Sequence(TemplateParameter "T") => Sequence (typ) | Set(TemplateParameter "T") => Set(typ) | OrderedSet(TemplateParameter "T") => OrderedSet (typ) | Collection(TemplateParameter "T") => Collection(typ) | Bag(TemplateParameter "T") => Bag(typ) (* nested types *) | Sequence (t) => Sequence (substitute_typ typ t) | Set (t) => Set (substitute_typ typ t) | OrderedSet (t) => OrderedSet (substitute_typ typ t) | Collection (t) => Collection (substitute_typ typ t) | Bag (t) => Bag (substitute_typ typ t) (* only parameter *) | TemplateParameter "T" => typ (* basic types *) | OclAny => OclAny | OclVoid => OclVoid | Integer => Integer | Real => Real | String => String | Boolean => Boolean | DummyT => DummyT | Classifier (path) => Classifier (path) (* else error *) | _ => raise TemplateInstantiationError ("Template type not of type: Sequence, Set, OrderedSet, Collection or Bag") end val _ = Logger.debug3 ("substitute classifier: parameter type: " ^ string_of_OclType typ ^ " template type: " ^ string_of_OclType (type_of classifier) ^ "\n") (* val typ = parameter type *) val styp = substitute_typ typ (type_of classifier) val _ = Logger.debug3 ("substitute_classifier: end substitute_type \n") val ops = substitute_operations typ (local_operations_of classifier) val _ = Logger.debug4 ("substitute parent.\n") val sparent = substitute_parent (type_of classifier) typ val _ = Logger.debug4 ("end substitute parent.\n") in (Class { name = styp, (* take the parent of the template parameter *) parent = sparent, (* a template has no attributes *) attributes = [], operations = ops, (* a template has no associationends *) associations = [], (* a template has no invariants *) invariant = [], (* a template has no stereotypes *) stereotypes = [], (* a template has no interfaces *) interfaces = [], (* a template's thyname is NONE *) thyname = NONE, (* a template's visibility is public *) visibility = public:Visibility, (* a template has no activity_graphs *) activity_graphs = [] }) end fun templ_of temp_typ para_typ [] = raise TemplateInstantiationError ("Error during instantiating a template" ^ "\n") | templ_of temp_typ para_typ (Template{parameter,classifier}::tail) = let val _ = Logger.debug4 ("Instantiate Template for classifier: " ^ (string_of_OclType (type_of classifier)) ^ "\n") in if ((type_of classifier) = temp_typ) then substitute_classifier para_typ classifier else templ_of temp_typ para_typ tail end | templ_of temp_typ para_typ (h::tail) = let val _ = Logger.debug4 ("shit") in templ_of temp_typ para_typ tail end val _ = Logger.debug3 ("Now dispatch type ...\n") in case typ of (* Primitive types of lib *) Boolean => class_of_t Boolean c | Integer => class_of_t Integer c | Real => class_of_t Real c | String => class_of_t String c (* Template types of lib *) | Sequence (T) => templ_of (Sequence(TemplateParameter "T")) T c | Set (T) => templ_of (Set(TemplateParameter "T")) T c | OrderedSet (T) => templ_of (OrderedSet(TemplateParameter "T")) T c | Bag (T) => templ_of (Bag(TemplateParameter "T")) T c | Collection (T) => templ_of (Collection(TemplateParameter "T")) T c (* Class types of lib *) | OclVoid => class_of_t OclVoid c | OclAny => let val _ = Logger.debug3 ("type is OclAny") in class_of_t OclAny c end (* Model types *) | Classifier (path) => let val _ = Logger.debug4 ("class_of_term: Classifier ("^(string_of_path path)^")\n") val res = class_of_t (Classifier (path)) c val _ = Logger.debug4 ("found: "^(string_of_path (name_of res)) ^"\n") in (*class_of_t (Classifier (path)) model*) res end | DummyT => let val _ = Logger.debug4 ("GetClassifierError: DummyT \n") in raise GetClassifierError ("No classifier of type: 'DummyT' \n") end | TemplateParameter (string) => let val _ = Logger.debug4 ("GetClassifierError: TemplateParameter ("^ string ^") \n") in raise GetClassifierError ("No classifier of type: 'TemplateParameter (string)' \n") end end fun class_of (name:Path) (model as (clist,alist)) = let val _ = Logger.debug3 ("top level package: " ^ (List.hd (name)) ^ "\n") val _ = Logger.debug3 ("remaining package: " ^ (String.concat (List.tl name)) ^ "\n") in class_of_term (Variable("x",type_of_path name model)) model handle TemplateInstantiationError s => let val _ = Logger.debug3 ("The path of the template parameter is not in the desing model.\n") val _ = Logger.debug3 ("Path = " ^ s ^ "\n") in raise TemplateError ("shit\n") end end fun class_of_type (typ:OclType) (model:transform_model) = let val _ = Logger.debug3 ("Rep_Core.class_of_type\n") val res = class_of_term (Variable ("x",typ)) model val _ = Logger.debug3 ("Rep_Core.class_of_type\n") in res end fun type_of_parents (Primitive {parent,...}) (model:transform_model) = ( case parent of NONE => [OclAny] | SOME (OclAny) => [OclAny] | SOME (t) => (t)::(type_of_parents (class_of_type t model) model) ) | type_of_parents (Class {parent,...}) model = ( case parent of NONE => [OclAny] | SOME (OclAny) => [OclAny] | SOME (t) => (t)::(type_of_parents (class_of_type t model) model) ) | type_of_parents (AssociationClass {parent,...}) model = ( case parent of NONE => [OclAny] | SOME (OclAny) => [OclAny] | SOME (t) => (t)::(type_of_parents (class_of_type t model) model) ) | type_of_parents (Interface {parents,...}) model = parents | type_of_parents (Template {classifier,...}) model = raise TemplateInstantiationError ("During Instantiation of template parent needn't to be accessed") fun type_equals Integer (Classifier ([OclLibPackage,"Real"])) = true | type_equals (Classifier ([OclLibPackage,"Integer"])) Real = true | type_equals _ OclAny = true | type_equals _ (Classifier ([OclLibPackage,"OclAny"])) = true | type_equals x y = if (x = y) then true else false fun conforms_to_up _ OclAny (_:transform_model) = true | conforms_to_up (Set(T1)) (Collection(T2)) model = let val _ = Logger.debug4 ("conforms_to_up: set -> collection \n") in if (conforms_to T1 T2 model) then true else false end | conforms_to_up (Bag(T1)) (Collection(T2)) model = let val _ = Logger.debug4 ("conforms_to_up: bag -> collection \n") in if (conforms_to T1 T2 model) then true else false end | conforms_to_up (Sequence(T1)) (Collection(T2)) model = let val _ = Logger.debug4 ("conforms_to_up: sequence -> collection \n") in if (conforms_to T1 T2 model) then true else false end | conforms_to_up (OrderedSet(T1)) (Collection(T2)) model = let val _ = Logger.debug4 ("conforms_to_up: orderedset -> collection \n") in if (conforms_to T1 T2 model) then true else false end | conforms_to_up typ1 typ2 (model as(classifiers,associations)) = let val class = class_of_type typ1 model val parents_types = type_of_parents (class) model val _ = Logger.debug4 ("conforms_to_up: ... \n") in member (typ2) (parents_types) end and (* RETRUN: Boolean *) conforms_to x y (model:transform_model) = let val _ = Logger.debug4 ("conforms_to: " ^ string_of_OclType x ^ " -> " ^ string_of_OclType y ^ " ? \n") in if (x = y) then true else if (type_equals x y) then true else conforms_to_up x y model end (* RETURN: OclTerm *) fun upcast (term,typ) = if (type_equals (type_of_term term) typ) then term else OperationWithType (term,type_of_term term,"oclIsTypeOf",typ,typ) fun parent_name_of (C as Class{parent,...}) = (case parent of NONE => name_of OclAnyC | SOME p => path_of_OclType p ) | parent_name_of (AC as AssociationClass{parent,...}) = (case parent of NONE => name_of OclAnyAC | SOME p => path_of_OclType p ) | parent_name_of (Interface{...}) = Logger.error "in Rep.parent_name_of: unsupported argument type Interface" | parent_name_of (E as Enumeration{parent,...}) = (case parent of NONE => Logger.error ("in Rep.parent_name_of: Enumeration "^ ((string_of_path o name_of) E) ^" has no parent") | SOME p => path_of_OclType p ) | parent_name_of (D as Primitive{parent,...}) = (case parent of NONE => name_of OclAnyC (* error ("Primitive "^((string_of_path o name_of) D)^" has no parent") *) | SOME p => path_of_OclType p ) | parent_name_of (Template _) = Logger.error "in Rep.parent_name_of: unsupported argument type Template" fun sig_conforms_to [] [] model = true | sig_conforms_to [] list model = let val result = false in result end | sig_conforms_to list [] model = let val result = false in result end | sig_conforms_to [(s1:string,sig_sub:OclType)] [(s2:string,sig_super:OclType)] model = let val result = if (conforms_to (sig_sub) (sig_super) model) then true else false in result end | sig_conforms_to ((s1:string,sig_sub:OclType)::tail1) ((s2:string,sig_super:OclType)::tail2) model = let val result = if (s2 = s1 andalso (conforms_to (sig_sub) (sig_super) model)) then sig_conforms_to tail1 tail2 model else false in result end fun operation_of cl fq_name = let val classname = (rev o tl o rev) fq_name val operations = operations_of (class_of classname cl) val name = (hd o rev) fq_name in SOME(hd (filter (fn a => if ((name_of_op a) = name) then true else false ) operations )) end fun type_of_att ({name,attr_type,...}:attribute) = attr_type fun same_op (sub_op:operation) (super_op:operation) (model:transform_model) = if ((name_of_op sub_op = name_of_op super_op ) andalso (sig_conforms_to (arguments_of_op sub_op) (arguments_of_op super_op) model)) then true else false fun same_att (sub_att:attribute) (super_att:attribute) (model:transform_model) = if ((name_of_att sub_att = name_of_att super_att) andalso (conforms_to (type_of_att sub_att) (type_of_att super_att) model)) then true else false fun same_ae (sub_ae:associationend) (super_ae:associationend) (model:transform_model) = if ((name_of_aend sub_ae = name_of_aend super_ae) andalso (conforms_to (type_of_aend sub_ae) (type_of_aend super_ae) model)) then true else false (* embed local operations to the inherited operations *) fun embed_local_operations [] iops model = iops | embed_local_operations x [] model = x | embed_local_operations (h::tail) iops model = let fun embed_local_operation oper [] model = [oper] | embed_local_operation lop ((oper:operation)::iops) model = if (same_op lop oper model) then (lop::iops) else (oper)::(embed_local_operation lop iops model) val tmp = embed_local_operation h iops model in (embed_local_operations tail tmp model) end fun embed_local_attributes [] iatts model = iatts | embed_local_attributes x [] model = x | embed_local_attributes (h::tail) iatts model = let fun embed_local_attribute att [] model = [att] | embed_local_attribute latt ((att:attribute)::iatts) model = if (same_att latt att model) then (latt::iatts) else (att)::(embed_local_attribute latt iatts model) val tmp = embed_local_attribute h iatts model in (embed_local_attributes tail tmp model) end fun embed_local_assocEnds [] iassE model = iassE | embed_local_assocEnds x [] model = x | embed_local_assocEnds (h::tail) iassEs model = let fun embed_local_assocEnd assE [] model = [assE] | embed_local_assocEnd lassE ((assE:associationend)::iassEs) model = if (same_ae lassE assE model) then (lassE::iassEs) else (assE)::(embed_local_assocEnd lassE iassEs model) val tmp = embed_local_assocEnd h iassEs model in (embed_local_assocEnds tail tmp model) end fun isColl_Type (Set(x)) = true | isColl_Type (Sequence(x)) = true | isColl_Type (OrderedSet(x)) = true | isColl_Type (Bag(x)) = true | isColl_Type (Collection(x)) = true | isColl_Type _ = false fun isValueType Integer = true | isValueType String = true | isValueType Real = true | isValueType Boolean = true | isValueType (Set(t)) = false | isValueType (OrderedSet(t)) = false | isValueType (Bag(t)) = false | isValueType (Sequence(t)) = false | isValueType OclAny = false | isValueType (Classifier s) = false | isValueType DummyT = false | isValueType OclVoid = false | isValueType t = Logger.error ("Error in isValueType(_,"^(string_of_OclType t)^")") fun parent_of_template (cl as Class{parent,...}:Classifier) (model:transform_model) = (case parent of NONE => ( case (isColl_Type (type_of cl)) of false => class_of_type OclAny model | true => class_of_type (Collection(OclAny)) model ) | SOME(x) => class_of_type x model ) | parent_of_template (asso as AssociationClass{parent,...}:Classifier) (model:transform_model) = (case parent of NONE => ( case (isColl_Type (type_of asso)) of false => class_of_type OclAny model | true => class_of_type (Collection(OclAny)) model ) | SOME(x) => class_of_type x model) | parent_of_template (enum as Enumeration{parent,...}:Classifier) (model:transform_model) = (case parent of NONE => ( case (isColl_Type (type_of enum)) of false => class_of_type OclAny model | true => class_of_type (Collection(OclAny)) model ) | SOME(x) => class_of_type x model) | parent_of_template (primi as Primitive{parent,...}:Classifier) (model:transform_model) = (case parent of NONE => ( case (isColl_Type (type_of primi)) of false => class_of_type OclAny model | true => class_of_type (Collection(OclAny)) model ) | SOME(x) => class_of_type x model) | parent_of_template (inf as Interface{parents,...}:Classifier) (model:transform_model) = (class_of_type (List.hd (parents)) model handle List.Empty => (case (isColl_Type (type_of inf)) of false => class_of_type OclAny model | true => class_of_type (Collection(OclAny)) model ) ) | parent_of_template (tmp as Template{classifier,...}) (model:transform_model) = raise TemplateError ("parent_of_template should never be used during Instantiation of a template.\n") (* never ending *) fun parents_of_help (C:Classifier) (model:transform_model) = let val this_type = type_of C val _ = Logger.debug3 ("type of C = " ^ (string_of_OclType this_type) ^ "\n") in case this_type of OclAny => [] | Collection(OclAny) => [] | Set(OclAny) => [] | Bag(OclAny) => [] | Sequence(OclAny) => [] | OrderedSet(OclAny) => [] | Collection(Collection _) => [] | Set(Set _) => [] | Bag(Bag _) => [] | Sequence(Sequence _) => [] | OrderedSet(OrderedSet _) => [] | Collection(T) => let val class_T = class_of_type (T) model val class_T' = parent_of_template class_T model val T' = type_of class_T' val col_T' = class_of_type (Collection(T')) model in [col_T']@(parents_of_help col_T' model) end | Set(T) => let val col_T = class_of_type (Collection(T)) model val class_T = class_of_type (T) model val class_T' = parent_of_template class_T model val T' = type_of class_T' val set_T' = class_of_type (Set(T')) model in [col_T]@(parents_of_help col_T model)@[set_T']@(parents_of_help set_T' model) end | OrderedSet(T) => let val set_T = class_of_type (Set(T)) model val col_T = class_of_type (Collection(T)) model val class_T = class_of_type (T) model val class_T' = parent_of_template class_T model val T' = type_of class_T' val ordset_T' = class_of_type (OrderedSet(T')) model in [set_T]@(parents_of_help set_T model)@[col_T]@(parents_of_help col_T model)@[ordset_T'] @(parents_of_help ordset_T' model) end | Bag(T) => let val col_T = class_of_type (Collection(T)) model val class_T = class_of_type (T) model val class_T' = parent_of_template class_T model val T' = type_of class_T' val bag_T' = class_of_type (Bag(T')) model in [col_T]@(parents_of_help col_T model)@[bag_T']@(parents_of_help bag_T' model) end | Sequence(T) => let val col_T = class_of_type (Collection(T)) model val class_T = class_of_type (T) model val class_T' = parent_of_template class_T model val T' = type_of class_T' val seq_T' = class_of_type (Sequence(T')) model in [col_T]@(parents_of_help col_T model)@[seq_T']@(parents_of_help seq_T' model) end | some_type => let val _ = Logger.debug3 ("parent_of_template \n") val parent = parent_of_template C model val _ = Logger.debug3 ("parent_of_template end, classifier = " ^ (String.concat (name_of parent)) ^ "\n") in [parent]@(parents_of_help parent model) end handle Empty => [OclAnyC] end fun parent_of (C:Classifier) model = parent_of_template C model handle Empty => OclAnyC fun parents_of (C:Classifier) model = let val _ = Logger.debug3 ("parents_of ... \n") val helper = (parents_of_help C model) in (if (helper = []) then ( if (isColl_Type (type_of C)) then [(class_of_type (Collection(OclAny)) model)] else [(class_of_type (OclAny) model)] ) else remove_dup (parents_of_help C model) ) handle Empty => [OclAnyC] end fun name_of_association ({name,aends,qualifiers,aclass}:association) = name fun path_of_association assoc = name_of_association assoc fun aends_of_association {name,aends,qualifiers,aclass} = aends fun associations_of (Class{name,associations,...}) = associations | associations_of (AssociationClass{name,associations,association,...}) = associations | associations_of (Primitive{name,associations,...}) = associations fun oppositeAendsOfAssociation name allAssociations associationPath = let val [association] = List.filter (fn assoc => path_of_association assoc = associationPath) allAssociations in List.filter (fn aend => type_of_aend aend <> name) (aends_of_association association) end fun incomingAendsOfAssociation name allAssociations associationPath = let val [association] = List.filter (fn assoc => path_of_association assoc = associationPath) allAssociations in List.filter (fn aend => type_of_aend aend = name) (aends_of_association association) end (** find the associationends belonging to a classifier. * This mean all other associationends from all associations the * classifer is part of. For association classes, the belonging * association also needs to be checked. * If the association is reflexiv, all aends will be returned. *) fun local_associationends_of (all_associations:association list) (Class{name,associations,...}):associationend list = let val _ = Logger.debug3 ("local_associationends_of 1 ... \n") val _ = Logger.debug3 ("classifier = " ^ (string_of_OclType name) ^ "\n") val oppAends = List.concat (List.map (fn a => let val _ = Logger.debug3 ("Association path = ") val _ = Logger.debug3 (string_of_path a ^ "\n") in (oppositeAendsOfAssociation name all_associations a) end ) associations) val _ = Logger.debug3 ("local_associationends_of 2 ... \n") val selfAends = map (incomingAendsOfAssociation name all_associations) associations val _ = Logger.debug3 ("local_associationends_of 3 ... \n") val filteredSelfAends = List.concat (List.filter (fn x => length x >= 2) selfAends) val _ = Logger.debug3 ("local_associationends_of 4 ... \n") in oppAends@filteredSelfAends end | local_associationends_of all_associations (AssociationClass{name,associations,association,...}) = (* association only contains endpoints to the other, pure classes *) let val _ = Logger.debug3 ("local_associationends_of 1 AssoCl ... \n") val assocs = if List.exists (fn x => x = association ) associations then associations else association::associations val _ = Logger.debug3 ("local_associationends_of 2 AssoCl ... \n") val oppAends = List.concat (map (oppositeAendsOfAssociation name all_associations) assocs) val _ = Logger.debug3 ("local_associationends_of 3 AssoCl ... \n") val selfAends = map (incomingAendsOfAssociation name all_associations) associations val _ = Logger.debug3 ("local_associationends_of 4 AssoCl ... \n") val filteredSelfAends = List.concat (List.filter (fn x => length x >= 2) selfAends) val _ = Logger.debug3 ("local_associationends_of 5 AssoCl ... \n") in oppAends@filteredSelfAends end | local_associationends_of all_associations (Primitive{name,associations,...}) = [] (* let val _ = Logger.debug3 ("local_associationends_of 1 Primi... \n") val oppAends = List.concat (map (oppositeAendsOfAssociation name all_associations) associations) val _ = Logger.debug3 ("local_associationends_of 2 primi ... \n") val selfAends = map (incomingAendsOfAssociation name all_associations) associations val _ = Logger.debug3 ("local_associationends_of 3 primi ... \n") val filteredSelfAends = List.concat (List.filter (fn x => length x >= 2) selfAends) val _ = Logger.debug3 ("local_associationends_of 4 primi ... \n") in oppAends@filteredSelfAends end *) | local_associationends_of [] model = [] fun associationends_of assocs classes = local_associationends_of assocs classes (* get all inherited operations of a classifier, without the local operations *) fun inherited_operations_of class (model as (clist,alist)) = let val _ = Logger.debug3 ("inh ops 0\n") val c_parents = parents_of class model val _ = Logger.debug3 ("inh ops: parents = " ^ (String.concat (List.map (fn a => (string_of_path (name_of a))) c_parents)) ^ " \n") val ops_of_par = (List.map (operations_of) c_parents) val _ = Logger.debug3 ("inh ops 2\n") in List.foldr (fn (a,b) => embed_local_operations a b model) (List.last (ops_of_par)) ops_of_par end fun inherited_attributes_of class (model as (clist,alist)) = let val _ = Logger.debug3 ("inh att 0\n") val c_parents = parents_of class model val _ = Logger.debug3 ("inh att 0\n") val atts_of_par = (List.map (attributes_of) c_parents) val _ = Logger.debug3 ("inh att 0\n") in if (List.length(atts_of_par) = 0) then [] else List.foldr (fn (a,b) => embed_local_attributes a b model) (List.last (atts_of_par)) atts_of_par end fun inherited_associationends_of class (model as (clist,alist)) = let val _ = Logger.debug3 ("inh assoEnd 0\n") val c_parents = parents_of class model val _ = Logger.debug3 ("inh assoEnd 1: parents = " ^ (String.concat (List.map (fn a => string_of_path (name_of a)) (c_parents))) ^ "\n") val assE_of_par = (List.map (associationends_of alist) c_parents) val _ = Logger.debug3 ("inh assoEnd 2\n") val _ = Logger.debug3 ("inh assoEnd 3: assocEnds of parents: " ^ (String.concat (List.map (fn a => (name_of_aend a)) (List.concat assE_of_par))) ^ "\n") in if (List.length(assE_of_par) = 0) then [] else List.foldr (fn (a,b) => embed_local_assocEnds a b model) (List.last (assE_of_par)) assE_of_par end (* get absolutelly all operations of a classifier. In case of a functions which occurs serveral times in the inheritance tree, the most specified function is listed. *) fun all_operations_of class model = let val lo = local_operations_of class val _ = Logger.debug3 ("all ops of classifier : "^ (string_of_path (name_of class)) ^ "\n") val io = inherited_operations_of class model val _ = Logger.debug3 ("all ops 2\n") in embed_local_operations lo io model end fun all_attributes_of class model = let val la = local_attributes_of class val _ = Logger.debug3 ("all atts of classifier : "^ (string_of_path (name_of class)) ^ "\n") val ia = inherited_attributes_of class model val _ = Logger.debug3 ("all atts 2\n") in embed_local_attributes la ia model end fun all_associationends_of class (model as (clist,alist)) = let val la = local_associationends_of alist class val _ = Logger.debug3 ("all assocEnds of classifier : " ^ (String.concat (name_of class)) ^ "\n") val _ = Logger.debug3 ("name of loacal assends: " ^ (String.concat (List.map (fn a => (name_of_aend a)) la)) ^ "\n") val ia = inherited_associationends_of class model val _ = Logger.debug3 ("name of inherited assends: " ^ (String.concat (List.map (fn a => (name_of_aend a)) ia)) ^ "\n") val _ = Logger.debug3 ("all assocEnds \n") in embed_local_assocEnds la ia model end (* get all local operations, which occurs in one of the parent classes at least each time also *) fun modified_operations_of class model = let val io = inherited_operations_of class model val lo = local_operations_of class fun op_exists (oper:operation) [] = false | op_exists (oper:operation) ((h:operation)::tail) = if (oper=h) then true else op_exists oper tail in optlist2list (List.map (fn a => if (op_exists a io) then NONE else (if (List.exists (fn b => same_op a b model) io) then SOME(a) else NONE )) lo) (* List.concat (List.map (fn a => List.filter (fn b => if (same_op a b model) then false else true) io) lo ) *) end fun modified_attributes_of class model = let val ia = inherited_attributes_of class model val la = local_attributes_of class fun att_exists (att:attribute) [] = false | att_exists (att:attribute) ((h:attribute)::tail) = if (att = h) then true else att_exists att tail in optlist2list (List.map (fn a => if (att_exists a ia) then NONE else (if (List.exists (fn b => same_att a b model) ia) then SOME(a) else NONE )) la) end fun creation_operations_of class (model:transform_model) = let val oper = all_operations_of class model val creators = List.filter (fn a => List.exists (fn b => b = "create") (#stereotypes a)) (oper) in creators end fun destruction_operations_of class (model:transform_model) = let val oper = all_operations_of class model val creators = List.filter (fn a => List.exists (fn b => b = "destroy") (#stereotypes a)) (oper) in creators end fun public_operations_of class (model:transform_model) = let val ops = all_operations_of class model in List.filter (fn a => (#visibility a) = public) ops end fun private_operations_of class (model:transform_model) = let val ops = all_operations_of class model in List.filter (fn a => (#visibility a) = private) ops end fun package_operations_of class (model:transform_model) = let val ops = all_operations_of class model in List.filter (fn a => (#visibility a) = package) ops end fun protected_operations_of class (model:transform_model) = let val ops = all_operations_of class model in List.filter (fn a => (#visibility a) = protected) ops end fun query_operations_of class (model:transform_model) = let val ops = all_operations_of class model in List.filter (fn a => (#isQuery a)) ops end fun command_operations_of class (model:transform_model) = let val ops = all_operations_of class model in List.filter (fn a => not (#isQuery a)) ops end (* convert an association end into the corresponding collection type *) fun convert_aend_type ({name,aend_type,multiplicity, ordered,visibility,init}:associationend) = (case multiplicity of [(0,1)] => aend_type | [(1,1)] => aend_type | _ =>if ordered then Rep_OclType.Sequence aend_type (* OrderedSet? *) else Rep_OclType.Set aend_type) fun convert_aend (cls_name:string) (aend:associationend):attribute = {name = List.last (#name aend), attr_type = convert_aend_type aend, visibility = #visibility aend, scope = XMI.InstanceScope, stereotypes = nil, init = #init aend} (* convert a multiplicity range into an invariant of the form *) (* size > lowerBound and size < upperBound ) *) fun range_to_inv cls_name aend (a,b) = let val cls = Rep_OclType.Classifier cls_name val attr_type = convert_aend_type aend val attr_name = cls_name@[List.last (#name aend)] val literal_a = Rep_OclTerm.Literal (Int.toString a, Rep_OclType.Integer) val literal_b = Rep_OclTerm.Literal (Int.toString b, Rep_OclType.Integer) val self = Rep_OclTerm.Variable ("self",cls) val attribute = Rep_OclTerm.AttributeCall (self,cls,attr_name,attr_type) val attribute_size = Rep_OclTerm.OperationCall (attribute,attr_type, ["oclLib","Collection","size"],[], Rep_OclType.Integer) val lower_bound = Rep_OclTerm.OperationCall (attribute_size,Rep_OclType.Integer, ["oclLib","Real",">="], [(literal_a,Rep_OclType.Integer)], Rep_OclType.Boolean) val upper_bound = Rep_OclTerm.OperationCall (attribute_size,Rep_OclType.Integer, ["oclLib","Real","<="], [(literal_b,Rep_OclType.Integer)], Rep_OclType.Boolean) val equal = Rep_OclTerm.OperationCall (attribute_size,Rep_OclType.Integer, ["oclLib","OclAny","="], [(literal_a,Rep_OclType.Integer)], Rep_OclType.Boolean) in if a = b then equal else if b = ~1 then lower_bound else Rep_OclTerm.OperationCall (lower_bound,Rep_OclType.Boolean, ["oclLib","Boolean","and"], [(upper_bound,Rep_OclType.Boolean)], Rep_OclType.Boolean) end fun path_of_aend ({name,aend_type,...}:associationend) = name fun substitute_templ_para (Collection(tt)) t = Collection (t) | substitute_templ_para (Set (tt)) t = Set (t) | substitute_templ_para (OrderedSet (tt)) t = OrderedSet (t) | substitute_templ_para (Sequence (tt)) t = Sequence (t) | substitute_templ_para (Bag (tt)) t = Bag (t) | substitute_templ_para t1 t2 = raise TemplateError ("Not possible to replace template parameter of a basic type. Type is: " ^ string_of_OclType t1 ^ " \n") fun type_of_template_parameter (Set t) = t | type_of_template_parameter (Sequence t) = t | type_of_template_parameter (Bag t) = t | type_of_template_parameter (Collection t) = t | type_of_template_parameter (OrderedSet t) = t | type_of_template_parameter t = raise NoCollectionTypeError t fun consistency_constraint cls_name (aend,revAend) = let fun aendIsSet (aend:associationend) = case #multiplicity aend of [(0,1)] => false | [(1,1)] => false | M => true fun mkCollection (a:associationend) = if (#ordered a) then (Sequence (#aend_type a)) else (Set (#aend_type a)) fun path_of_classifier (Classifier p) = p val cons_inv_name = ("consistencyconstraint_for_aend_"^ (short_name_of_path (#name aend))) val revPath = (path_of_classifier (#aend_type aend))@[List.last (#name revAend)] val selfVar = Rep_OclHelper.self (Rep_OclType.Classifier cls_name) val attPath = (path_of_classifier (#aend_type revAend))@[List.last (#name aend)] val targetType = if aendIsSet aend then mkCollection aend else #aend_type aend val targetVar = Rep_OclTerm.Variable ("x",#aend_type aend) val target = Rep_OclHelper.ocl_attcall selfVar attPath targetType val revType = if aendIsSet revAend then mkCollection revAend else (#aend_type revAend) val sources = Rep_OclHelper.ocl_attcall targetVar revPath (revType) val back = Rep_OclHelper.ocl_attcall target revPath revType val oclTrue = Rep_OclTerm.Literal ("true",Rep_OclType.Boolean) val body = case (aendIsSet aend, aendIsSet revAend) of (false,false) => Rep_OclHelper.ocl_eq back selfVar | (false,true) => Rep_OclHelper.ocl_includes back selfVar | (true,false) => Rep_OclHelper.ocl_forAll target [targetVar] (Rep_OclHelper.ocl_eq sources selfVar) | (true,true) => Rep_OclHelper.ocl_forAll target [targetVar] (Rep_OclHelper.ocl_includes sources selfVar) in (SOME cons_inv_name, body) end fun multiplicity_constraint cls_name (aend:associationend) = let val mult_inv_name = ("multconstraint_for_aend_"^ (short_name_of_path (#name aend))) val range_constraints = (case (#multiplicity aend) of [(0,1)] => [] | [(1,1)] => let val attr_name = cls_name@[List.last (#name aend)] val attr_type = convert_aend_type aend val cls = Rep_OclType.Classifier cls_name val self = Rep_OclTerm.Variable ("self",cls) val attribute = Rep_OclTerm.AttributeCall (self,cls, attr_name,attr_type) in [Rep_OclTerm.OperationCall (attribute,attr_type, ["oclIsDefined"],[], Rep_OclType.Boolean)] end | _ => map (range_to_inv cls_name aend) (#multiplicity aend)) in if range_constraints = [] then (SOME mult_inv_name, Rep_OclTerm.Literal ("true", Rep_OclType.Boolean)) else (SOME mult_inv_name, Rep_OclHelper.ocl_or_all range_constraints) end (** calculate the invariants of an association end: * 1. multiplicity constraints * 2. consistency constraints between opposing association ends * i.e., A.b.a->includes(A) * params {cls_name,(aend,revPath)} * @param cls_name Path of source classifier * @param aend aend to be converted * @param revAend the reverse navigation of aend *) fun aend_to_inv cls_name (aend:associationend,revAend:associationend) = [ consistency_constraint cls_name (aend,revAend), multiplicity_constraint cls_name aend] fun association_of_aend ({name,aend_type,...}:associationend) = List.take(name, (List.length name)-1) fun role_of_aend ({name,aend_type,...}:associationend) = List.last name fun bidirectionalPairs name allAssociations associationPaths = let fun combine [] [] = [] | combine (xs::xss) ([y]::ys) = map (fn x => (x,y)) xs @ (combine xss ys) | combine (xs::xss) ((b::bs)::ys) = map (fn x => (x,b)) xs @ map (fn x => (x,b)) bs @ map (fn x => (b,x)) bs (* need symmetry in this case *) @ (combine (xs::xss) (bs::ys)) val otherAends = map (oppositeAendsOfAssociation name allAssociations) associationPaths val selfAends = map(incomingAendsOfAssociation name allAssociations) associationPaths in combine otherAends selfAends end fun aendToAttCall (name,oclTerm) = let fun aendToAtt (Rep_OclTerm.AssociationEndCall(source,sourceType,path, resultType)) = (Rep_OclTerm.AttributeCall(source,sourceType,path,resultType)) | aendToAtt x = x in (name,Rep_OclHelper.mapOclCalls aendToAtt oclTerm) end (** convert association ends into attributes + invariants * Associations belonging to an association class have not been modified to * include an additional aend to the association class. *) fun normalize (all_associations:association list) (C as (Class {name,parent,attributes,operations,associations, invariant,stereotypes,interfaces,thyname, visibility,activity_graphs})):Classifier = let val _ = Logger.debug2 ("Rep_Core:normalize: class\n") val _ = Logger.debug2 ("number of associations: "^(Int.toString(List.length associations) )^"\n") val _ = map (Logger.debug2 o (fn x => "association path: "^x^"\n") o string_of_path) associations fun mapPath (aend1,aend2) = (aend1,path_of_aend aend2) (* val aendPathPairs = map mapPath (bidirectionalPairs name all_associations associations)*) val aendPathPairs = bidirectionalPairs name all_associations associations val _ = Logger.debug2 ("Rep_Core: end normalize \n") in Class {name = name, parent = parent, attributes = append (map (convert_aend (List.last(path_of_OclType name))) (associationends_of all_associations C)) attributes, operations = operations, associations = nil, invariant = append (List.concat (map (aend_to_inv (path_of_OclType name)) aendPathPairs)) (map aendToAttCall invariant), stereotypes = stereotypes, interfaces = interfaces, thyname = thyname, visibility = visibility, activity_graphs = activity_graphs} end | normalize all_associations (AC as (AssociationClass {name,parent,attributes,association, associations,operations,invariant, stereotypes,interfaces, thyname,visibility, activity_graphs})) = (* FIXME: how to handle AssociationClass.association? *) let val _ = Logger.debug2 ("Rep_Core.normalize AssociationClass\n") val _ = Logger.debug2 ("number of associations: "^ (Int.toString (List.length associations ))^"\n") fun mapPath (aend1,aend2) = (aend1,path_of_aend aend2) val aendPathPairs = (bidirectionalPairs name all_associations associations) val res = AssociationClass { name = name, parent = parent, attributes = append (map (convert_aend (List.last (path_of_OclType name))) (associationends_of all_associations AC)) attributes, operations = operations, invariant = append (List.concat( map (aend_to_inv (path_of_OclType name)) aendPathPairs)) (map aendToAttCall invariant), stereotypes = stereotypes, interfaces = interfaces, thyname = thyname, activity_graphs = activity_graphs, associations = [], visibility=visibility, association = [] (* FIXME? *)} val _ = Logger.debug2 ("Rep_Core.normalize") in res end | normalize all_associations (Primitive p) = (* Primitive's do not have attributes, so we have to convert *) (* them into Classes... *) if (#associations p) = [] then Primitive p else normalize all_associations (Class { name = (#name p), parent = (#parent p), attributes=[], operations=(#operations p), invariant = (#invariant p), associations = (#associations p), stereotypes = (#stereotypes p), interfaces = (#interfaces p), thyname = (#thyname p), visibility = public, activity_graphs=[]}) | normalize all_associations c = c fun rm_init_attr (attr:attribute) = { name = #name attr, attr_type = #attr_type attr, visibility = #visibility attr, scope = #scope attr, stereotypes = #stereotypes attr, init = NONE }:attribute fun ListIntersect f [] ys = [] | ListIntersect f (x::xs) ys = if List.exists (fn y => ((f x) = (f y))) ys then [x]@(ListIntersect f xs ys) else (ListIntersect f xs ys) fun ListMinus f [] ys = [] | ListMinus f (x::xs) ys = if List.exists (fn y => ((f x)= (f y))) ys then (ListMinus f xs ys) else [x]@(ListMinus f xs ys) fun ListRmDuplicates f [] = [] | ListRmDuplicates f (x::xs) = if List.exists (fn y => ((f x) = (f y))) xs then (ListRmDuplicates f xs) else [x]@(ListRmDuplicates f xs) fun rmDuplicates ((a_cl,a_assoc):transform_model) = (ListRmDuplicates name_of a_cl, ListRmDuplicates name_of_association a_assoc) fun union ((a_cl,a_assoc):transform_model) ((b_cl,b_assoc):transform_model) = (a_cl@b_cl,a_assoc@b_assoc) fun intersection ((a_cl,a_assoc):transform_model) ((b_cl,b_assoc):transform_model) = (ListIntersect name_of a_cl b_cl, ListIntersect name_of_association a_assoc b_assoc) fun minus ((a_cl,a_assoc):transform_model) ((b_cl,b_assoc):transform_model) = (ListMinus name_of a_cl b_cl, ListMinus name_of_association a_assoc b_assoc) fun isDisjunct ((a_cl,a_assoc):transform_model) ((b_cl,b_assoc):transform_model) = (List.length (ListIntersect name_of a_cl b_cl) = 0) andalso (List.length (ListIntersect name_of_association a_assoc b_assoc) = 0) fun toString ((cl,assoc):transform_model) = let fun cmap f l = String.concat (map f l) in (Int.toString(List.length cl))^" Classifier(s): " ^(cmap (fn c => ((string_of_path o name_of) c)^" ") cl)^"\n" ^(Int.toString(List.length assoc))^" Association(s): " ^(cmap (fn c => ((string_of_path o name_of_association) c)^" ") assoc)^"\n" end fun init_to_inv cls_name (attr:attribute) = (case (#init attr) of NONE => (SOME ("init_"^(#name attr)), Rep_OclTerm.Literal ("true",Rep_OclType.Boolean)) | SOME(init) => let val attr_name = cls_name@[#name attr] val attr_type = #attr_type attr val cls = Rep_OclType.Classifier cls_name val self = Rep_OclTerm.Variable ("self",cls) val attribute = Rep_OclTerm.AttributeCall (self,cls,attr_name, attr_type) in (SOME ("init_"^(#name attr)), Rep_OclTerm.OperationCall (Rep_OclTerm.OperationCall (self,cls, ["oclLib","OclAny","oclIsNew"],[],Rep_OclType.Boolean), Rep_OclType.Boolean, ["oclLib","Boolean","implies"], [(Rep_OclTerm.OperationCall (attribute, attr_type,["oclLib","OclAny","="], [(init,attr_type)], Rep_OclType.Boolean), Rep_OclType.Boolean)], Rep_OclType.Boolean) ) end) fun normalize_init (Class {name,parent,attributes,operations, associations,invariant, stereotypes,interfaces,thyname,visibility,activity_graphs}) = Class {name = name, parent = parent, attributes = (map rm_init_attr attributes), operations = operations, associations = nil, invariant = append (map (init_to_inv (path_of_OclType name)) attributes) invariant, stereotypes = stereotypes, interfaces = interfaces, thyname = thyname, visibility=visibility, activity_graphs=activity_graphs} | normalize_init (AssociationClass {name,parent,attributes,operations, associations,association, invariant,stereotypes,interfaces, thyname,visibility,activity_graphs}) = AssociationClass {name = name, parent = parent, attributes = (map rm_init_attr attributes), operations = operations, associations = nil, association = []:Path (* FIXME: better dummy? *), invariant = append (map (init_to_inv (path_of_OclType name)) attributes) invariant, stereotypes = stereotypes, interfaces = interfaces, visibility=visibility, thyname = thyname, activity_graphs=activity_graphs} | normalize_init c = c fun normalize_ext ((classifiers,associations):transform_model) = (* no distinguishing for valid binary associations *) (map (normalize associations) classifiers, []) fun string_of_path (path:Rep_OclType.Path) = (case path of [] => "" | p => foldr1 (fn (a,b) => a^"."^b) p) fun update_thyname tname (Class{name,parent,attributes,operations,invariant, stereotypes,interfaces,associations, visibility,activity_graphs,...}) = Class{name=name, parent=parent, attributes=attributes, operations=operations, associations=associations, invariant=invariant, stereotypes=stereotypes, interfaces=interfaces, thyname=(SOME tname), visibility=visibility, activity_graphs=activity_graphs } | update_thyname tname (AssociationClass{name,parent,attributes,operations, invariant,stereotypes,interfaces, associations,association, visibility,activity_graphs,...}) = AssociationClass{name=name, parent=parent, attributes=attributes, operations=operations, associations=associations, association=association, invariant=invariant, stereotypes=stereotypes, interfaces=interfaces, thyname=(SOME tname), visibility=visibility, activity_graphs=activity_graphs } | update_thyname tname (Interface{name,parents,operations,stereotypes, invariant,...}) = Interface{name=name, parents=parents, operations=operations, stereotypes=stereotypes, invariant=invariant, thyname=(SOME tname)} | update_thyname tname (Enumeration{name,parent,operations,literals, invariant,stereotypes,interfaces,...}) = Enumeration{name=name, parent=parent, operations=operations, literals=literals, invariant=invariant, stereotypes=stereotypes, interfaces=interfaces, thyname=(SOME tname)} | update_thyname tname (Primitive{name,parent,operations,associations, invariant,stereotypes,interfaces,...}) = Primitive{name=name, parent=parent, operations=operations, associations=associations, invariant=invariant, stereotypes=stereotypes, interfaces=interfaces, thyname=(SOME tname)} | update_thyname _ (Template T) = Logger.error ("in update_thyname: Template does not have a theory") fun update_invariant invariant' (Class{name,parent,attributes,operations, invariant,stereotypes,interfaces, associations,visibility,activity_graphs,thyname}) = Class{name=name, parent=parent, attributes=attributes, operations=operations, associations=associations, invariant=invariant', stereotypes=stereotypes, interfaces=interfaces, thyname=thyname, visibility=visibility, activity_graphs=activity_graphs } | update_invariant invariant' (AssociationClass{name,parent,attributes, operations,invariant, stereotypes,interfaces, association,associations, visibility,activity_graphs,thyname}) = AssociationClass{name=name, parent=parent, attributes=attributes, operations=operations, associations=associations, association=association, invariant=invariant', stereotypes=stereotypes, interfaces=interfaces, thyname=thyname, visibility=visibility, activity_graphs=activity_graphs } | update_invariant invariant' (Interface{name,parents,operations,stereotypes, invariant,thyname}) = Interface{name=name, parents=parents, operations=operations, stereotypes=stereotypes, invariant=invariant', thyname=thyname} | update_invariant invariant' (Enumeration{name,parent,operations,literals, invariant,stereotypes,interfaces, thyname}) = Enumeration{name=name, parent=parent, operations=operations, literals=literals, invariant=invariant', stereotypes=stereotypes, interfaces=interfaces, thyname=thyname} | update_invariant invariant' (Primitive{name,parent,operations,associations, invariant,stereotypes,interfaces, thyname}) = Primitive{name=name, parent=parent, operations=operations, associations=associations, invariant=invariant', stereotypes=stereotypes, interfaces=interfaces, thyname=thyname} | update_invariant _ (Template T) = Logger.error ("in update_invariant: Template does not have an invariant") fun update_operations operations' (Class{name,parent,attributes,invariant, operations,stereotypes,interfaces, associations,activity_graphs, visibility,thyname}) = Class{name=name, parent=parent, attributes=attributes, invariant=invariant, associations=associations, operations=operations', stereotypes=stereotypes, interfaces=interfaces, visibility=visibility, thyname=thyname, activity_graphs=activity_graphs } | update_operations operations' (AssociationClass{name,parent,attributes, invariant,operations, stereotypes,interfaces, associations,association, visibility, activity_graphs,thyname}) = AssociationClass{name=name, parent=parent, attributes=attributes, invariant=invariant, associations=associations, association=association, operations=operations', stereotypes=stereotypes, interfaces=interfaces, visibility=visibility, thyname=thyname, activity_graphs=activity_graphs } | update_operations operations' (Interface{name,parents,invariant, stereotypes,operations,thyname}) = Interface{name=name, parents=parents, invariant=invariant, stereotypes=stereotypes, operations=operations', thyname=thyname} | update_operations operations' (Enumeration{name,parent,invariant,literals, operations,stereotypes, interfaces,thyname}) = Enumeration{name=name, parent=parent, invariant=invariant, literals=literals, operations=operations', stereotypes=stereotypes, interfaces=interfaces, thyname=thyname} | update_operations operations' (Primitive{name,parent,invariant, associations,operations, stereotypes,interfaces,thyname}) = Primitive{name=name, parent=parent, invariant=invariant, associations=associations, operations=operations', stereotypes=stereotypes, interfaces=interfaces, thyname=thyname} | update_operations _ (Template T) = Logger.error ("in update_operations: Template does not have operations") fun update_precondition pre' ({name,precondition,postcondition,body,arguments, result,isQuery,scope,stereotypes,visibility}:operation) = {name=name, precondition=pre', postcondition=postcondition, arguments=arguments, body=body, result=result, isQuery=isQuery, scope=scope, visibility=visibility, stereotypes=stereotypes}:operation fun update_postcondition post' ({name,precondition,postcondition,body, arguments,result,isQuery,scope, stereotypes, visibility}:operation) = {name=name, precondition=precondition, postcondition=post', arguments=arguments, body=body, result=result, isQuery=isQuery, scope=scope, visibility=visibility, stereotypes=stereotypes}:operation fun visibility_of (Class{visibility,...}) = visibility | visibility_of (AssociationClass{visibility,...}) = visibility | visibility_of (Primitive{...}) = public | visibility_of (Template{classifier,...}) = visibility_of classifier fun short_name_of C = case (name_of C) of [] => Logger.error "in Rep.short_name_of: empty type" | p => (hd o rev) p fun stereotypes_of (Class{stereotypes,...}) = stereotypes | stereotypes_of (AssociationClass{stereotypes,...}) = stereotypes | stereotypes_of (Interface{stereotypes,...}) = stereotypes | stereotypes_of (Enumeration{stereotypes,...}) = stereotypes | stereotypes_of (Primitive{stereotypes,...}) = stereotypes | stereotypes_of (Template _) = Logger.error "in Rep.stereotypes_of: \ \unsupported argument type Template" fun package_of (Class{name,...}) = if (length (path_of_OclType name)) > 1 then take (((length (path_of_OclType name)) -1), (path_of_OclType name)) else [] | package_of (AssociationClass{name,...}) = if (length (path_of_OclType name)) > 1 then take (((length (path_of_OclType name)) -1), (path_of_OclType name)) else [] | package_of (Interface{name,...}) = if (length (path_of_OclType name)) > 1 then take (((length (path_of_OclType name)) -1), (path_of_OclType name)) else [] | package_of (Enumeration{name,...}) = if (length (path_of_OclType name)) > 1 then take (((length (path_of_OclType name)) -1), (path_of_OclType name)) else [] | package_of (Primitive{name,...}) = if (length (path_of_OclType name)) > 1 then take (((length (path_of_OclType name)) -1), (path_of_OclType name)) else [] | package_of (Template{classifier,...}) = package_of classifier fun classes_of_package pkg (model as (clist,alist)) = List.filter (fn a => package_of a = pkg) clist fun substitute_package [] tpackage [] = raise Rep_CoreError ("Not possible to substitute package since names belongs to package itself and not a class of it.\n") | substitute_package [] tpackage path = tpackage@path | substitute_package x tpackage [] = raise Rep_CoreError ("Not Possible to substitute Package since package longer than path.\n") | substitute_package (hf::fpackage) (tpackage) (hp::path) = if (hf = hp) then substitute_package fpackage tpackage path else (hp::path) fun parent_short_name_of C = (case (parent_name_of C) of [] => Logger.error "in Rep.parent_short_name_of: empty type" | p => (hd o rev) p) fun parent_package_of (Class{parent,...}) = (case parent of NONE => package_of OclAnyC | SOME q => let val p = path_of_OclType q in if (length p) > 1 then (take (((length p) -1),p)) else [] end) | parent_package_of (AssociationClass{parent,...}) = (case parent of NONE => package_of OclAnyC | SOME q => let val p = path_of_OclType q in if (length p) > 1 then (take (((length p) -1),p)) else [] end) | parent_package_of (Interface{...}) = Logger.error "in Rep.parent_package_of: unsupported argument type Interface" | parent_package_of (E as Enumeration{parent,...}) = (case parent of NONE => Logger.error ("in Rep.parent_package_of: Enumeration "^ (string_of_path o name_of) E^ " has no parent") | SOME q => let val p = path_of_OclType q in if (length p) > 1 then (take (((length p) -1),p)) else [] end ) | parent_package_of (Primitive{parent,...}) = (case parent of NONE => package_of OclAnyC (* NONE => Logger.error "Primitive has no parent" *) | SOME q => let val p = path_of_OclType q in if (length p) > 1 then (take (((length p) -1),p)) else [] end) | parent_package_of (Template{...}) = Logger.error "in Rep.parent_package_of: unsupported argument type Template" (* Get parent interfaces of a Classifier. *) fun parent_interfaces_of (Interface{parents,...}) = parents | parent_interfaces_of (Class{interfaces,...}) = interfaces | parent_interfaces_of (AssociationClass{interfaces,...}) = interfaces | parent_interfaces_of (Enumeration{interfaces,...}) = interfaces | parent_interfaces_of (Primitive{interfaces,...}) = interfaces | parent_interfaces_of (Template{...}) = Logger.error "parent_interfaces_of