(***************************************************************************** * su4sml --- a 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 * * 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 joinModel : transform_model -> 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 (** * 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 * *****************************************) (** * 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 Path *) val type_of_path : Rep_OclType.Path -> 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 (** * Prefixes a type with a given package name. *) val prefix_type : string list -> Rep_OclType.OclType -> Rep_OclType.OclType (** * 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 (***************************************** * 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 (***************************************** * OPERATIONS * *****************************************) (** * 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 (** * 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 * *****************************************) (** * 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 (** * 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 -> Classifier list -> Classifier (** * Returns all parents of a classifier. *) val parents_of : Classifier -> Classifier list -> Rep_OclType.Path 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 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 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 NoParentForDatatype of string exception NoModelReferenced of string exception NoCollectionTypeError of Rep_OclType.OclType end structure Rep_Core : REP_CORE = struct open library 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 val OclLibPackage = "oclLib" val OclAnyC = Class{name=Rep_OclType.OclAny,parent=NONE,attributes=[], operations=[], interfaces=[], invariant=[],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 (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 name_of_op ({name,...}:operation) = 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 type_of_path ["Integer"] = Integer | type_of_path ["Boolean"] = Boolean | type_of_path ["Real"] = Real | type_of_path ["OclAny"] = OclAny | type_of_path ["DummyT"] = DummyT | type_of_path ["String"] = String | type_of_path ["OclVoid"] = OclVoid | type_of_path (("oclLib")::tail) = type_of_path tail | 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) 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))) 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])) end else Classifier ([set]) | type_of_path list = Classifier (list) 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 operations_of class = local_operations_of class fun class_of_term source (c:Classifier list, a:association list) = let val typ = type_of_term (source) val _ = map (fn a => trace development (string_of_OclType (type_of a) ^ "manu type: \n")) c 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 _ = trace low ("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 (Set (t)) = SOME (Collection t) | substitute_parent (OrderedSet (t)) = SOME (Set (t)) | substitute_parent (Sequence (t)) = SOME (Collection (t)) | substitute_parent (Bag (t)) = SOME (Collection t) | substitute_parent (Collection (t)) = SOME (Collection (t)) | substitute_parent t = SOME (Collection t) and substitute_operations typ [] = [] | substitute_operations typ ((oper:operation)::tail) = let val _ = trace low ("\n\nsubstitute operation : " ^ (#name oper) ^ " ... \n") val args = substitute_args typ (#arguments oper) val res = substitute_typ typ (#result oper) val _ = trace 100 ("check\n") 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 _ = trace low ("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 _ = trace low ("substitute classifier: parameter type: " ^ string_of_OclType typ ^ " template type: " ^ string_of_OclType (type_of classifier) ^ "\n") val styp = substitute_typ typ (type_of classifier) val ops = substitute_operations typ (local_operations_of classifier) val _ = trace 100 ("substitute parent.\n") val sparent = substitute_parent typ val _ = trace 100 ("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 _ = trace low ("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 _ = trace development ("shit") in templ_of temp_typ para_typ tail end 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 => class_of_t OclAny c (* Model types *) | Classifier (path) => let val _ = trace development ("class_of_term: Classifier ("^(string_of_path path)^")\n") val res = class_of_t (Classifier (path)) c val _ = trace development ("found: "^(string_of_path (name_of res)) ^"\n") in (*class_of_t (Classifier (path)) model*) res end | DummyT => let val _ = trace development ("GetClassifierError: DummyT \n") in raise GetClassifierError ("No classifier of type: 'DummyT' \n") end | TemplateParameter (string) => let val _ = trace development ("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 _ = trace low ("top level package: " ^ (List.hd (name)) ^ "\n") val _ = trace low ("remaining package: " ^ (String.concat (List.tl name)) ^ "\n") in class_of_term (Variable("x",type_of_path name)) model end and class_of_type (typ:OclType) (model:transform_model) = class_of_term (Variable ("x",typ)) model 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 _ = trace low ("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 _ = trace low ("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 _ = trace low ("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 _ = trace low ("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 _ = trace low ("conforms_to_up: ... \n") in member (typ2) (parents_types) end and (* RETRUN: Boolean *) conforms_to x y (model:transform_model) = let val _ = trace low ("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 *) and upcast (term,typ) = if (type_equals (type_of_term term) typ) then term else OperationWithType (term,type_of_term term,"oclIsTypeOf",typ,typ) (* RETURN: OclType list *) and 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 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{...}) = error "in Rep.parent_name_of: unsupported argument type Interface" | parent_name_of (E as Enumeration{parent,...}) = (case parent of NONE => 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 _) = error "in Rep.parent_name_of: unsupported argument type Template" fun parents_of C cl = (case parent_name_of C of [] => [] | class => (if( class = (name_of OclAnyC) ) then [(name_of OclAnyC)] else [class]@(parents_of (class_of class (cl,[])) cl))) 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 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 (* 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 (* get all inherited operations of a classifier, without the local operations *) fun inherited_operations_of class (model as (clist,alist)) = let val parents = parents_of class (#1 model) val _ = trace 50 ("inh ops 2\n") val c_parents = List.map (fn a => class_of_type (type_of_path a) model) parents val _ = trace 50 ("inh ops 3\n") val ops_of_par = (List.map (operations_of) c_parents) val _ = trace 50 ("inh ops 4\n") in List.foldr (fn (a,b) => embed_local_operations a b model) (List.last (ops_of_par)) ops_of_par end (* get absolutelly all operations of a classifier. In case of a functions which occurs serveral times in the inheritance tree, the must specified function is listed. *) fun all_operations_of class model = let val lo = local_operations_of class val _ = trace 50 ("all ops 1\n") val io = inherited_operations_of class model val _ = trace 50 ("all ops 2\n") in embed_local_operations lo io 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 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 name_of_association ({name,aends,qualifiers,aclass}:association) = name fun path_of_association assoc = name_of_association assoc fun short_name_of_path p = (hd o rev) p 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 typ = case typ of Set(t) => t | Sequence(t) => t | Bag(t) => t | Collection(t) => t | OrderedSet(t) => t | 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 aends_of_association {name,aends,qualifiers,aclass} = aends fun association_of_aend ({name,aend_type,...}:associationend) = List.take(name, (List.length name)-1) fun type_of_aend ({name,aend_type,...}:associationend) = aend_type fun type_of_att ({name,attr_type,...}:attribute) = attr_type fun name_of_aend ({name,aend_type,...}:associationend) = short_name_of_path name fun role_of_aend ({name,aend_type,...}:associationend) = List.last name 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 associationends_of (all_associations:association list) (Class{name,associations,...}):associationend list = let val oppAends = List.concat (map (oppositeAendsOfAssociation name all_associations) associations) val selfAends = map (incomingAendsOfAssociation name all_associations) associations val filteredSelfAends = List.concat (List.filter (fn x => length x >= 2) selfAends) in oppAends@filteredSelfAends end | associationends_of all_associations (AssociationClass{name,associations, association,...}) = (* association only contains endpoints to the other, pure classes *) let val assocs = if List.exists (fn x => x = association ) associations then associations else association::associations val oppAends = List.concat (map (oppositeAendsOfAssociation name all_associations) assocs) val selfAends = map (incomingAendsOfAssociation name all_associations) associations val filteredSelfAends = List.concat (List.filter (fn x => length x >= 2) selfAends) in oppAends@filteredSelfAends end | associationends_of all_associations (Primitive{name,associations,...}) = let val oppAends = List.concat (map (oppositeAendsOfAssociation name all_associations) associations) val selfAends = map (incomingAendsOfAssociation name all_associations) associations val filteredSelfAends = List.concat (List.filter (fn x => length x >= 2) selfAends) in oppAends@filteredSelfAends end | associationends_of _ _ = error ("in associationends_of: This classifier has no associationends") (*FIXME: or rather []? *) 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 _ = trace function_calls "normalize: class\n" val _ = trace function_arguments ("number of associations: "^(Int.toString(List.length associations) )^"\n") val _ = map (trace function_arguments 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 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 _ = trace function_calls "normalize: associationclass\n" val _ = trace function_arguments ("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) in 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? *)} 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 joinModel ((a_cl,a_assoc):transform_model) ((b_cl,b_assoc):transform_model) = (a_cl@b_cl,a_assoc@b_assoc) 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) = 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) = 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) = 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 (Template{classifier,...}) = visibility_of classifier fun short_name_of C = case (name_of C) of [] => 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 _) = 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 parent_short_name_of C = (case (parent_name_of C) of [] => 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{...}) = error "in Rep.parent_package_of: unsupported argument type Interface" | parent_package_of (E as Enumeration{parent,...}) = (case parent of NONE => 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 => 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{...}) = 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{...}) = error "parent_interfaces_of