compile error fixes
git-svn-id: https://projects.brucker.ch/su4sml/svn/su4sml/trunk@7173 3260e6d1-4efc-4170-b0a7-36055960796d
This commit is contained in:
Martin Bill
parent
093afd6030
commit
88ad63bd3f
|
|
@ -66,104 +66,36 @@ type modelTransformation = Rep_Core.transform_model * transformFlag list
|
|||
|
||||
|
||||
(* (JD) maybe not all of the following functions need to be exported.
|
||||
* e.g., generate_pairs, ...
|
||||
*)
|
||||
|
||||
val transformClassifiers_ext : Rep_Core.transform_model -> Rep.Model
|
||||
val transformClassifiersExt : Rep_Core.transform_model -> Rep.Model
|
||||
val transformClassifiers : Rep_Core.transform_model -> Rep.Classifier list
|
||||
val transformFile : string -> Rep.Model
|
||||
|
||||
(* transforms *)
|
||||
val transform_association_classes: Rep_Core.transform_model ->
|
||||
val transformAssociationClasses: Rep_Core.transform_model ->
|
||||
Rep_Core.transform_model (* split an association classe into a class and an association*)
|
||||
val transform_qualifiers : Rep_Core.transform_model -> Rep_Core.transform_model
|
||||
val transform_aggregation: Rep_Core.transform_model -> Rep_Core.transform_model
|
||||
val transform_n_ary_associations : Rep_Core.transform_model ->
|
||||
val transformQualifiers : Rep_Core.transform_model -> Rep_Core.transform_model
|
||||
val transformAggregation: Rep_Core.transform_model -> Rep_Core.transform_model
|
||||
val transformNAryAssociations : Rep_Core.transform_model ->
|
||||
Rep_Core.transform_model (* remove n-ary associations *)
|
||||
val transform_multiplicities : Rep_Core.transform_model ->
|
||||
val transformMultiplicities : Rep_Core.transform_model ->
|
||||
Rep_Core.transform_model (* remove multiplicities *)
|
||||
|
||||
(* helper functions *)
|
||||
(**
|
||||
* returns the path of an association end. The path of an association end
|
||||
* is <path_of_association>@[<name_of_aend>].
|
||||
* @params {aend}
|
||||
* @param aend association end
|
||||
* @return path of association end
|
||||
*)
|
||||
val path_of_aend : Rep_Core.associationend -> Rep_OclType.Path
|
||||
|
||||
val role_of_aend : Rep_Core.associationend -> string
|
||||
(**
|
||||
* 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 : Rep_Core.associationend -> Rep_OclType.OclType
|
||||
(**
|
||||
* 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 : Rep_Core.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 : Rep_Core.associationend -> string
|
||||
(**
|
||||
* returns the list of specified multiplicities for this association end.
|
||||
* @params {aend}
|
||||
* @param aend association end
|
||||
* @return the list of multiplicities of this association end. If there are
|
||||
* no multiplicities, an empty list is returned.
|
||||
*)
|
||||
val multiplicities_of_aend : Rep_Core.associationend -> (int*int) list
|
||||
(**
|
||||
* returns the qualifying part of the (fully) qualified name.
|
||||
* @params {qualifiedName}
|
||||
* @param qualifiedName path denoting a name
|
||||
* @return all but the last part of qualifiedName
|
||||
*)
|
||||
val get_qualifier : Rep_OclType.Path -> Rep_OclType.Path
|
||||
|
||||
(**
|
||||
* Remove all multiplicities from the association
|
||||
* @params {assoc}
|
||||
* @param assoc association
|
||||
* @return assoc with all multiplicities removed
|
||||
*)
|
||||
val stripMultiplicities : Rep_Core.association -> Rep_Core.association
|
||||
val generate_pairs : 'a list -> ('a * 'a) list (* including symmetry *)
|
||||
val update_classifier_with_constraint : Rep_Core.constraint ->
|
||||
Rep_Core.Classifier -> Rep_Core.Classifier
|
||||
(* single: exactly 1 match *)
|
||||
val update_classifiers_single : Rep_Core.Classifier list -> Rep_OclType.OclType -> (Rep_Core.Classifier -> Rep_Core.Classifier) -> Rep_Core.Classifier list
|
||||
val updateClassifiersWithConstraints: Rep_Core.Classifier list ->
|
||||
Rep_OclType.OclType ->
|
||||
Rep_Core.constraint list ->
|
||||
Rep_Core.Classifier list
|
||||
val get_association : Rep_Core.association list -> Rep_OclType.Path ->
|
||||
Rep_Core.association
|
||||
val split_on_association: Rep_Core.association list -> Rep_OclType.Path ->
|
||||
Rep_Core.association * Rep_Core.association list
|
||||
(* only one of the below will remain *)
|
||||
val get_other_associationends: Rep_Core.association list -> Rep_OclType.Path -> Rep_OclType.OclType -> Rep_Core.associationend list
|
||||
val get_other_associationends_alt : Rep_Core.association list -> Rep_OclType.OclType -> Rep_OclType.Path -> Rep_Core.associationend list
|
||||
val get_associationends : Rep_Core.association list -> Rep_OclType.Path -> Rep_Core.associationend list
|
||||
val associationends_of : Rep_Core.association -> Rep_Core.associationend list
|
||||
|
||||
(* result: (Variable list , OCL expression for set intersection)*)
|
||||
val reachable_set : Rep_Core.associationend -> Rep_Core.associationend list -> (Rep_OclTerm.OclTerm list * Rep_OclTerm.OclTerm)
|
||||
val within_bounds : Rep_OclTerm.OclTerm -> (int*int) -> Rep_OclTerm.OclTerm
|
||||
val within_aend_multiplicities : Rep_Core.associationend -> Rep_Core.associationend list -> string -> Rep_Core.constraint
|
||||
val injective_constraint : Rep_OclType.Path -> Rep_OclType.OclType -> Rep_Core.associationend list -> string -> Rep_Core.constraint
|
||||
|
||||
exception NotYetImplemented of string
|
||||
exception InvalidArguments of string
|
||||
|
||||
|
|
@ -175,6 +107,9 @@ struct
|
|||
datatype transformFlag = BinaryAssociationsOnly
|
||||
type modelTransformation = Rep_Core.transform_model * transformFlag list
|
||||
-> Rep_Core.transform_model * transformFlag list
|
||||
|
||||
open List
|
||||
open ListPair
|
||||
open library
|
||||
open Transform_Library
|
||||
open Rep_OclTerm
|
||||
|
|
@ -182,6 +117,7 @@ open Rep_OclType
|
|||
open Rep_OclHelper
|
||||
open Rep_Core
|
||||
|
||||
|
||||
infix |>>
|
||||
fun (x |>> f) = (f x)
|
||||
|
||||
|
|
@ -194,130 +130,6 @@ exception InvalidArguments of string
|
|||
§ ***********************************)
|
||||
val triv_expr = Rep_OclTerm.Literal ("true",Rep_OclType.Boolean)
|
||||
|
||||
(* (JD) -> Rep_OclType? *)
|
||||
fun get_short_name (path:Path):string =
|
||||
List.last path
|
||||
|
||||
fun stripMultiplicities ({name,aends,aclass}:association):association =
|
||||
let
|
||||
fun handleAend {name,aend_type,multiplicity,visibility,
|
||||
ordered,init} =
|
||||
{name=name,
|
||||
aend_type=aend_type,
|
||||
multiplicity=[],
|
||||
visibility=visibility,
|
||||
ordered=ordered,
|
||||
init=init}
|
||||
in
|
||||
{name = name,
|
||||
aends = map handleAend aends,
|
||||
aclass = aclass}
|
||||
end
|
||||
|
||||
fun generate_pairs [] =
|
||||
error "in generate_pairs: argument list is empty" (* or simply return []? *)
|
||||
| generate_pairs [a] =
|
||||
[(a,a)]
|
||||
| generate_pairs [a,b] =
|
||||
(* not necessary *)
|
||||
[(a,b),(b,a)]
|
||||
| generate_pairs (x::xs) =
|
||||
let
|
||||
val pairs = map (fn a => (x,a)) xs
|
||||
val rev_pairs = map (fn a => (a,x)) xs
|
||||
in
|
||||
pairs@rev_pairs@(generate_pairs xs)
|
||||
end
|
||||
|
||||
fun update_classifier_with_constraint constraint (Class{name,parent,attributes,
|
||||
operations,associations,invariant,stereotypes,interfaces,thyname,
|
||||
activity_graphs}) =
|
||||
Class {name = name,
|
||||
parent = parent,
|
||||
attributes = attributes,
|
||||
operations = operations,
|
||||
associations = associations,
|
||||
invariant = constraint::invariant,
|
||||
stereotypes = stereotypes,
|
||||
interfaces = interfaces,
|
||||
thyname = thyname,
|
||||
activity_graphs = activity_graphs}
|
||||
| update_classifier_with_constraint constraint (AssociationClass {name,parent,
|
||||
attributes,operations,associations,association,invariant,stereotypes,
|
||||
interfaces,thyname,activity_graphs}) =
|
||||
AssociationClass {name = name,
|
||||
parent = parent,
|
||||
attributes = attributes,
|
||||
operations = operations,
|
||||
associations = associations,
|
||||
association = association,
|
||||
invariant = constraint::invariant,
|
||||
stereotypes = stereotypes,
|
||||
interfaces = interfaces,
|
||||
thyname = thyname,
|
||||
activity_graphs = activity_graphs}
|
||||
| update_classifier_with_constraint constraint (Interface {name,parents,
|
||||
operations,stereotypes,invariant,thyname}) =
|
||||
Interface {name=name,
|
||||
parents=parents,
|
||||
operations=operations,
|
||||
stereotypes=stereotypes,
|
||||
invariant=constraint::invariant,
|
||||
thyname=thyname}
|
||||
| update_classifier_with_constraint constraint (Enumeration {name,parent,
|
||||
operations,literals,invariant,stereotypes,interfaces,thyname}) =
|
||||
Enumeration {name = name,
|
||||
parent = parent,
|
||||
operations = operations,
|
||||
literals=literals,
|
||||
invariant = constraint::invariant,
|
||||
stereotypes = stereotypes,
|
||||
interfaces = interfaces,
|
||||
thyname = thyname}
|
||||
| update_classifier_with_constraint constraint (Primitive {name,parent,
|
||||
operations,associations,invariant,stereotypes,interfaces,thyname}) =
|
||||
Primitive{name = name,
|
||||
parent = parent,
|
||||
operations = operations,
|
||||
associations = associations,
|
||||
invariant = constraint::invariant,
|
||||
stereotypes = stereotypes,
|
||||
interfaces = interfaces,
|
||||
thyname = thyname}
|
||||
| update_classifier_with_constraint constraint (Template {parameter,
|
||||
classifier}) =
|
||||
Template{parameter=parameter,
|
||||
classifier = update_classifier_with_constraint
|
||||
constraint classifier} (* sensible? *)
|
||||
|
||||
fun update_classifiers_single (all_classifiers:Classifier list)
|
||||
(classifier:OclType) (update:Classifier -> Classifier) :Classifier list=
|
||||
let
|
||||
val (match,rest) = List.partition
|
||||
(fn (Class {name,...}) => name=classifier
|
||||
| (AssociationClass {name,...}) => name=classifier
|
||||
| (Interface {name,...}) => name=classifier
|
||||
| (Enumeration {name,...}) => name=classifier
|
||||
| (Primitive {name,...}) => name=classifier
|
||||
| _ => false ) all_classifiers
|
||||
in
|
||||
case match of
|
||||
[x] => (update x)::rest
|
||||
| [] => error "in update_classifiers_single: no match found"
|
||||
| _ => error "in update_classifiers_single: more than 1 match found"
|
||||
end
|
||||
|
||||
fun update_classifiers_with_constraints (all_classifiers:Classifier list)
|
||||
(classifier:OclType) (con::constraints:constraint list) :Classifier list =
|
||||
let
|
||||
val modified_clsses = update_classifiers_single all_classifiers classifier
|
||||
(update_classifier_with_constraint con)
|
||||
in
|
||||
update_classifiers_with_constraints modified_clsses classifier
|
||||
constraints
|
||||
end
|
||||
| update_classifiers_with_constraints all_classifiers _ [] = all_classifiers
|
||||
|
||||
fun get_association (all_assocs: Rep_Core.association list) (assoc_path:Path):
|
||||
association =
|
||||
let
|
||||
|
|
@ -362,100 +174,6 @@ fun associationends_of (assoc:association):associationend list =
|
|||
#aends assoc
|
||||
end
|
||||
|
||||
fun reachable_set (_:associationend) ([]:associationend list) = error "rep_transform.get_reachable_set: empty source list"
|
||||
| reachable_set (target:associationend) ([source]:associationend list) =
|
||||
let
|
||||
val src_var = Variable(name_of_aend source ,type_of_aend source)
|
||||
in
|
||||
([src_var], ocl_aendcall src_var (path_of_aend target) (type_of_aend target))
|
||||
end
|
||||
| reachable_set (target:associationend) ((source::rest):associationend list) =
|
||||
let
|
||||
val (old_vars,intermediate) = reachable_set target rest
|
||||
val src_var = Variable(name_of_aend source ,type_of_aend source)
|
||||
val new_set = ocl_aendcall src_var (path_of_aend target) (type_of_aend target)
|
||||
in
|
||||
(src_var::old_vars ,ocl_intersection_set new_set intermediate)
|
||||
end
|
||||
|
||||
|
||||
fun within_bounds (set:Rep_OclTerm.OclTerm) ((lower,upper):int*int):Rep_OclTerm.OclTerm =
|
||||
let
|
||||
val size = ocl_size set
|
||||
val lower_lit = Literal (Int.toString lower,Integer)
|
||||
val upper_lit = Literal (Int.toString upper,Integer)
|
||||
val lower_bound = ocl_geq size lower_lit
|
||||
val upper_bound = ocl_leq size upper_lit
|
||||
in
|
||||
ocl_and lower_bound upper_bound
|
||||
end
|
||||
|
||||
fun withinAendMultiplicities targetAend sourceAends name =
|
||||
let
|
||||
val _ = trace function_calls "withinAendMultiplicities\n"
|
||||
val tgt_multiplicities = multiplicities_of_aend target
|
||||
val tgt_name = name_of_aend target
|
||||
val tgt_type = type_of_aend target
|
||||
val (variables,set) = reachable_set target sources
|
||||
val constr_body = ocl_or_all (map (within_bounds set) tgt_multiplicities)
|
||||
val tgt_variable = Variable(tgt_name,tgt_type)
|
||||
val allInstances = ocl_allInstances tgt_variable
|
||||
val constr_complete = ocl_forAll allInstances variables constr_body
|
||||
val constraint = (SOME name,constr_complete)
|
||||
in
|
||||
constraint
|
||||
end
|
||||
|
||||
fun injective_constraint (source_path:Path) (source_type:OclType) (targets:associationend list) (name:string):constraint =
|
||||
let
|
||||
val source_name = get_short_name source_path
|
||||
val src_var = Variable(source_name,source_type)
|
||||
fun role_bounds src_var aend =
|
||||
let
|
||||
val name = path_of_aend aend
|
||||
val aend_type = type_of_aend aend
|
||||
val set = ocl_aendcall src_var name aend_type
|
||||
val size = ocl_size set
|
||||
val bounds = ocl_eq size (Literal("1",Integer))
|
||||
in
|
||||
bounds
|
||||
end
|
||||
fun role_equals src_var src2_var aend =
|
||||
let
|
||||
val name = path_of_aend aend
|
||||
val aend_type = type_of_aend aend
|
||||
val set = ocl_aendcall src_var name aend_type
|
||||
val size = ocl_size set
|
||||
val match = ocl_eq size (Literal("1",Integer))
|
||||
in
|
||||
match
|
||||
end
|
||||
val roles = map (role_bounds src_var) targets
|
||||
val roles_part = ocl_and_all roles
|
||||
val allInstances = ocl_allInstances src_var
|
||||
val src_var2 = Variable(source_name^"2",source_type)
|
||||
val matches = map (role_equals src_var src_var2) targets
|
||||
val matches_anded = ocl_and_all roles
|
||||
val matches_equal = ocl_eq src_var src_var2
|
||||
val matches_imp = ocl_implies matches_anded matches_equal
|
||||
val allInstances2 = ocl_allInstances src_var2
|
||||
val matches_part = ocl_forAll allInstances2 [src_var2] matches_imp
|
||||
val constr_body = ocl_and roles_part matches_part
|
||||
val constr_complete = ocl_forAll allInstances [src_var] constr_body
|
||||
in
|
||||
(SOME name,constr_complete)
|
||||
end
|
||||
|
||||
fun split_on_association (associations:association list) (path:Path): (association * association list) =
|
||||
let
|
||||
fun belonging_association tgt {name,aends,aclass} = tgt = name
|
||||
val ([assoc],others) = List.partition (belonging_association path)
|
||||
associations
|
||||
in
|
||||
(assoc, others)
|
||||
end
|
||||
|
||||
|
||||
(****************************
|
||||
******** Transforms ********
|
||||
****************************)
|
||||
|
|
@ -467,7 +185,7 @@ fun split_on_association (associations:association list) (path:Path): (associati
|
|||
* generates: constraint, AssociationClass
|
||||
* removes: qualifier
|
||||
*)
|
||||
fun transform_qualifiers ((all_classifiers,all_associations):transform_model):
|
||||
fun transformQualifiers ((all_classifiers,all_associations):transform_model):
|
||||
transform_model =
|
||||
(all_classifiers,all_associations) (*dummy*)
|
||||
|
||||
|
|
@ -476,8 +194,8 @@ fun transform_qualifiers ((all_classifiers,all_associations):transform_model):
|
|||
* generates: constraint
|
||||
* removes: aggregation
|
||||
*)
|
||||
fun transform_aggregation ((all_classifiers,all_associations):transform_model):transform_model =
|
||||
(all_classifiers,all_associations) (*dummy*)
|
||||
fun transformAggregation (allClassifiers,allAssociations) =
|
||||
(allClassifiers,allAssociations) (*dummy*)
|
||||
|
||||
|
||||
(*****************************************************************************)
|
||||
|
|
@ -499,20 +217,85 @@ fun transform_aggregation ((all_classifiers,all_associations):transform_model):t
|
|||
*)
|
||||
fun transformAssociationClassIntoClass (AssociationClass
|
||||
{name,parent,attributes,operations,
|
||||
associations,association,
|
||||
associations,association,
|
||||
invariant,stereotypes,interfaces,
|
||||
thyname,activity_graphs}) =
|
||||
(trace function_calls "transformAssociationClassIntoClass\n",
|
||||
Class { name = name,
|
||||
parent = parent,
|
||||
attributes = attributes,
|
||||
operations = operations,
|
||||
associations = associations,
|
||||
invariant = constraint::invariant,
|
||||
stereotypes = stereotypes,
|
||||
interfaces = interfaces,
|
||||
thyname = thyname,
|
||||
activity_graphs = activity_graphs})
|
||||
parent = parent,
|
||||
attributes = attributes,
|
||||
operations = operations,
|
||||
associations = associations,
|
||||
invariant = invariant,
|
||||
stereotypes = stereotypes,
|
||||
interfaces = interfaces,
|
||||
thyname = thyname,
|
||||
activity_graphs = activity_graphs})
|
||||
|
||||
(**
|
||||
* Process an association: add the dummy class, generate the matching-
|
||||
* constraint and update the classifiers with that constraint.
|
||||
*)
|
||||
fun generalTransfromNAryAssociation dummy (association as {name,aends,
|
||||
aclass=NONE},
|
||||
(classifiers,processedAssocs)) =
|
||||
let
|
||||
val _ = trace function_calls "transformNAryAssociation\n"
|
||||
fun modifyClassifier ((assocs,classifier),classifiers) =
|
||||
let
|
||||
val ([cls],rem) = partition (fn x => name_of x = name_of
|
||||
classifier)
|
||||
classifiers
|
||||
in
|
||||
modifyAssociationsOfClassifier assocs [association] cls ::rem
|
||||
end
|
||||
|
||||
fun consistency [] refer [] [] [] = []
|
||||
| consistency (source::xs) refer (selfAend::ys) (roles::zs)
|
||||
(refRoles::us) =
|
||||
consistencyOclConstraint source refer selfAend roles refRoles ::
|
||||
(consistency xs refer ys zs us)
|
||||
|
||||
fun addOcl ((classifier,ocls), classifiers) =
|
||||
let
|
||||
val ([cls],rem) = partition (fn x => classifier = x) classifiers
|
||||
in
|
||||
addInvariants ocls cls :: rem
|
||||
end
|
||||
|
||||
(* extract participants/members and form associations *)
|
||||
val (assocMembers,rem) = matchClassifiersAtAend aends classifiers
|
||||
val (binaryAssocs,oppRefAends) = binaryAssociations dummy assocMembers
|
||||
aends
|
||||
val (clsses,roleNames, oppAends, splitAssocs) = splitNAryAssociation
|
||||
association
|
||||
assocMembers
|
||||
val assocMemberPairs = zip (map (fn x => [x]) binaryAssocs,assocMembers)
|
||||
val splitMemberPairs = zip (splitAssocs,assocMembers)
|
||||
|
||||
(* update association membership info in classifiers *)
|
||||
val modifiedClassifiers = foldl modifyClassifier classifiers
|
||||
(assocMemberPairs @ splitMemberPairs)
|
||||
val dummy = modifyAssociationsOfClassifier binaryAssocs [] dummy
|
||||
|
||||
(* generate and add OCL constraints *)
|
||||
val uniquenessOCL = uniquenessOclConstraint dummy binaryAssocs
|
||||
val selfAends = matchAends oppRefAends (zip (clsses,roleNames))
|
||||
val refRoles = map (matchAends oppRefAends) oppAends
|
||||
val namedConsistencyOCLs = consistency clsses dummy selfAends oppAends
|
||||
refRoles
|
||||
val multiplicitiesOCL =
|
||||
multiplicityOclConstraint dummy (map multiplicity_of_aend aends)
|
||||
oppRefAends
|
||||
val dummy = addInvariants (uniquenessOCL::multiplicitiesOCL) dummy
|
||||
val modifiedClassifiers = foldl addOcl modifiedClassifiers
|
||||
namedConsistencyOCLs
|
||||
|
||||
(* update references to removed associations *)
|
||||
(*val modifiedClassifiers = TODO *)
|
||||
in
|
||||
(dummy::modifiedClassifiers, binaryAssocs@splitAssocs@processedAssocs)
|
||||
end
|
||||
|
||||
(**
|
||||
* Transform an AssociationClass into a Class and an Association
|
||||
|
|
@ -529,13 +312,15 @@ fun transformAssociationClasses (allClassifiers,allAssociations) =
|
|||
val ([dummy],rem) = List.partition (fn x => name_of x = aClass)
|
||||
classifiers
|
||||
in
|
||||
generalTransfromNAryAssociation dummy ({name=name,aends=aends,aclass=NONE},
|
||||
generalTransfromNAryAssociation dummy ({name=name,aends=aends,
|
||||
aclass=NONE},
|
||||
(rem,procAssocs))
|
||||
end
|
||||
|
||||
fun stripAcAssoc ({name,aends,aclass=SOME aClass},classifiers) =
|
||||
let
|
||||
val (ac,rem) = List.partition (fn x => name_of x = aClass) classifiers
|
||||
val (ac,rem) = List.partition (fn x => name_of x = aClass)
|
||||
classifiers
|
||||
in
|
||||
transformAssociationClassIntoClass ac ::rem
|
||||
end
|
||||
|
|
@ -548,77 +333,6 @@ fun transformAssociationClasses (allClassifiers,allAssociations) =
|
|||
(modifiedClassifiers,modifiedAssociations@rem)
|
||||
end
|
||||
|
||||
fun transformNAryAssociation (association,(classifiers,procAssocs)) =
|
||||
generalTransfromNAryAssociation (newDummyClass o package_of_association
|
||||
association)
|
||||
(association,(classifiers,procAssocs))
|
||||
|
||||
(**
|
||||
* Process an association: add the dummy class, generate the matching-
|
||||
* constraint and update the classifiers with that constraint.
|
||||
*)
|
||||
fun generalTransfromNAryAssociation dummy (association as {name,aends,NONE},
|
||||
(classifiers,processedAssocs)) =
|
||||
let
|
||||
val _ = trace function_calls "transformNAryAssociation\n"
|
||||
fun modifyClassifiers ((assoc,classifier),classifiers) =
|
||||
let
|
||||
val ([cls],rem) = partition (fn x => name_of x = name_of
|
||||
classifier)
|
||||
classifiers
|
||||
in
|
||||
modifyAssociationsOfClassifier [assoc] [association] cls ::rem
|
||||
end
|
||||
|
||||
fun consistency [] ref [] [] [] = []
|
||||
| consistency (source::xs) ref (selfAend::ys) (roles::zs)
|
||||
(refRoles::us) =
|
||||
consistencyOclConstraint source ref selfAend roles refRoles ::
|
||||
(consistency xs ref ys zs us)
|
||||
|
||||
fun addOcl ((classifier,ocls), classifiers) =
|
||||
let
|
||||
val ([cls],rem) = partition (fn x => classifier = x) classifiers
|
||||
in
|
||||
addInvariants ocls cls :: rem
|
||||
end
|
||||
|
||||
fun matchClassifiers oppRefAends (cls,role) =
|
||||
matchClassifier oppRefAends cls role
|
||||
|
||||
(* extract participants/members and form associations *)
|
||||
val (assocMembers,rem) = matchClassifierAtAend classifiers aends
|
||||
val (binaryAssocs,oppRefAends) = binaryAssociations dummy assocMembers
|
||||
aends
|
||||
val (clsses,roleNames, oppAends, splitAssocs) = splitNAryAssociation
|
||||
association
|
||||
assocMembers
|
||||
val assocMemberPairs = zip binaryAssocs assocMembers
|
||||
val splitMemberPairs = zip splitAssocs assocMembers
|
||||
|
||||
(* update association membership info in classifiers *)
|
||||
val modifiedClassifiers = foldl modifyClassifiers classifiers
|
||||
(assocMemberPairs@splitMemeberPairs)
|
||||
val dummy = modifyAssociationsOfClassifier binaryAssocs [] dummy
|
||||
|
||||
(* generate and add OCL constraints *)
|
||||
val uniquenessOCL = uniquenessOclConstraint dummy binaryAssocs
|
||||
val selfAends = matchClassifiers oppRefAends (zip clsses roleNames)
|
||||
val refRoles = map (matchAends oppRefAends) oppAends
|
||||
val namedConsistencyOCLs = consistency clsses dummy selfAends oppAends
|
||||
refRoles
|
||||
val multiplicitiesOCL =
|
||||
multiplicityOclConstraint dummy (map multiplicity_of_aend aends)
|
||||
binaryAssocs
|
||||
val dummy = addInvariants (uniquenessOCL::multiplicitiesOCL) dummy
|
||||
val modifiedClassifiers = foldl addOcl modifiedClassifiers
|
||||
namedConsistencyOCLs
|
||||
|
||||
(* update references to removed associations *)
|
||||
(*val modifiedClassifiers = TODO *)
|
||||
in
|
||||
(dummy::modifiedClassifiers, binaryAssocs@splitAssocs@processedAssocs)
|
||||
end
|
||||
|
||||
(**
|
||||
* We need OCL constraints and an additional dummy class to handle the broken
|
||||
|
|
@ -634,6 +348,11 @@ fun generalTransfromNAryAssociation dummy (association as {name,aends,NONE},
|
|||
fun transformNAryAssociations (allClassifiers,allAssociations) =
|
||||
let
|
||||
val _ = trace function_calls "transform_n_ary_associations\n"
|
||||
fun transformNAryAssociation (association,(classifiers,procAssocs)) =
|
||||
generalTransfromNAryAssociation
|
||||
(newDummyClass (package_of_association association))
|
||||
(association,(classifiers,procAssocs))
|
||||
|
||||
val (nAryAssocs,rem) = partition isPureNAryAssoc allAssociations
|
||||
val (modifiedClassifiers,modifiedAssociations) =
|
||||
foldl transformNAryAssociation (allClassifiers,[]) nAryAssocs
|
||||
|
|
@ -672,47 +391,48 @@ fun transformMultiplicities (allClassifiers,allAssociations) =
|
|||
(SOME name, term)
|
||||
end
|
||||
|
||||
fun addMultiplicityConstraints (assoc as {name,aends=[a,b],NONE},
|
||||
fun addMultiplicityConstraints (assoc as {name,aends=[a,b],aclass=NONE},
|
||||
localClassifiers) =
|
||||
let
|
||||
val _ = trace function_calls "addMultiplicityConstraints\n"
|
||||
val aType = type_of_aend a
|
||||
val bType = type_of_aend b
|
||||
val _ = trace function_calls "addMultiplicityConstraints\n"
|
||||
val aType = type_of_aend a
|
||||
val bType = type_of_aend b
|
||||
val aPath = path_of_aend a
|
||||
val bPath = path_of_aend b
|
||||
val aName = name_of_aend a
|
||||
val bName = name_of_aend b
|
||||
val aConstrName = "BinaryMultiplicity"^a_name
|
||||
val bConstrName = "BinaryMultiplicity"^b_name
|
||||
val modifiedTmp =
|
||||
val aName = name_of_aend a
|
||||
val bName = name_of_aend b
|
||||
val aConstrName = "BinaryMultiplicity"^aName
|
||||
val bConstrName = "BinaryMultiplicity"^bName
|
||||
val modifiedTmp =
|
||||
(case (multiplicities_of_aend a) of
|
||||
[] => localClassifiers
|
||||
| multis =>
|
||||
let
|
||||
val aConstraint = binaryConstraint aType bType bPath
|
||||
val aConstraint = binaryConstraint aType bType bPath
|
||||
multis aConstrName
|
||||
in
|
||||
updateClassifiersWithConstraints classifiers aType
|
||||
in
|
||||
updateClassifiersWithConstraints localClassifiers aType
|
||||
[aConstraint]
|
||||
end)
|
||||
val modifiedClassifiers =
|
||||
end)
|
||||
val modifiedClassifiers =
|
||||
(case (multiplicities_of_aend b) of
|
||||
[] => modifiedTmp
|
||||
| multis =>
|
||||
let
|
||||
val bConstraint = binaryConstraint bType aType aPath
|
||||
let
|
||||
val bConstraint = binaryConstraint bType aType aPath
|
||||
multis bConstrName
|
||||
in
|
||||
updateClassifiersWithConstraints modifiedTmp bType
|
||||
in
|
||||
updateClassifiersWithConstraints modifiedTmp bType
|
||||
[bConstraint]
|
||||
end)
|
||||
in
|
||||
modifiedClassifiers
|
||||
end
|
||||
|
||||
end)
|
||||
in
|
||||
modifiedClassifiers
|
||||
end
|
||||
|
||||
(* filter the valid associations *)
|
||||
val (binaryAssociations,rem) = partition isPureBinAssoc allAssociations
|
||||
|
||||
val (binaryAssociations,rem) = List.partition isPureBinAssoc
|
||||
allAssociations
|
||||
|
||||
(* add the constraints to the classifiers *)
|
||||
val modifiedClassifiers = foldl addMultiplicityConstraints
|
||||
allClassifiers binaryAssociations
|
||||
|
|
@ -745,7 +465,7 @@ fun transformClassifiersExt (model:Rep_Core.transform_model):Rep_Core.transform_
|
|||
transformNAryAssociations
|
||||
|
||||
fun transformClassifiers (model:transform_model):Rep.Classifier list =
|
||||
fst (transformClassifiers_ext model) (* return classifiers *)
|
||||
fst (transformClassifiersExt model) (* return classifiers *)
|
||||
|
||||
|
||||
(**
|
||||
|
|
@ -753,7 +473,8 @@ fun transformClassifiers (model:transform_model):Rep.Classifier list =
|
|||
* @return a list of rep classifiers, or nil in case of problems
|
||||
*)
|
||||
fun transformFile f:transform_model = (info ("opening "^f);
|
||||
(normalize_ext o transformClassifiers_ext o RepParser.transformXMI_ext o XmiParser.readFile) f)
|
||||
(normalize_ext o transformClassifiersExt o
|
||||
RepParser.transformXMI_ext o XmiParser.readFile) f)
|
||||
(* handle ex as (IllFormed msg) => raise ex *)
|
||||
|
||||
exception FileNotFound of string
|
||||
|
|
|
|||
|
|
@ -18,8 +18,14 @@ val uniquenessOclConstraint : Rep_Core.Classifier ->
|
|||
* @params {source,multis,binaryAssocs}
|
||||
*)
|
||||
val multiplicityOclConstraint: Rep_Core.Classifier -> (int*int) list list ->
|
||||
Rep_Core.association list ->
|
||||
Rep_Core.associationend list ->
|
||||
Rep_Core.constraint list
|
||||
val consistencyOclConstraint: Rep_Core.Classifier ->
|
||||
Rep_Core.Classifier ->
|
||||
Rep_Core.associationend ->
|
||||
Rep_Core.associationend list ->
|
||||
Rep_Core.associationend list ->
|
||||
(Rep_Core.Classifier * Rep_Core.constraint list)
|
||||
|
||||
(**
|
||||
* @params {association,assocMembers}
|
||||
|
|
@ -60,9 +66,14 @@ val matchAends: Rep_Core.associationend list ->
|
|||
(**
|
||||
*
|
||||
*)
|
||||
val matchClassifiers: Rep_Core.associationend list ->
|
||||
(Rep_Core.Classifier * string) list
|
||||
-> Rep_Core.associationend list
|
||||
val matchAendsAtClassifier: Rep_Core.associationend list ->
|
||||
(Rep_Core.Classifier * string) list
|
||||
-> Rep_Core.associationend list
|
||||
|
||||
val matchClassifiersAtAend: Rep_Core.associationend list ->
|
||||
Rep_Core.Classifier list ->
|
||||
(Rep_Core.Classifier list *
|
||||
Rep_Core.Classifier list )
|
||||
|
||||
(**
|
||||
* Form binary associations between
|
||||
|
|
@ -102,12 +113,77 @@ val isPureNAryAssoc: Rep_Core.association -> bool
|
|||
*)
|
||||
val isPureBinAssoc : Rep_Core.association -> bool
|
||||
|
||||
(**
|
||||
* returns the path of an association end. The path of an association end
|
||||
* is <path_of_association>@[<name_of_aend>].
|
||||
* @params {aend}
|
||||
* @param aend association end
|
||||
* @return path of association end
|
||||
*)
|
||||
val path_of_aend : Rep_Core.associationend -> Rep_OclType.Path
|
||||
|
||||
val role_of_aend : Rep_Core.associationend -> string
|
||||
(**
|
||||
* 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 : Rep_Core.associationend -> Rep_OclType.OclType
|
||||
(**
|
||||
* 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 : Rep_Core.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 : Rep_Core.associationend -> string
|
||||
(**
|
||||
* returns the list of specified multiplicities for this association end.
|
||||
* @params {aend}
|
||||
* @param aend association end
|
||||
* @return the list of multiplicities of this association end. If there are
|
||||
* no multiplicities, an empty list is returned.
|
||||
*)
|
||||
val multiplicities_of_aend : Rep_Core.associationend -> (int*int) list
|
||||
|
||||
(**
|
||||
* Remove all multiplicities from the association
|
||||
* @params {assoc}
|
||||
* @param assoc association
|
||||
* @return assoc with all multiplicities removed
|
||||
*)
|
||||
val stripMultiplicities : Rep_Core.association -> Rep_Core.association
|
||||
(* result: (Variable list , OCL expression for set intersection)*)
|
||||
val reachableSet : Rep_Core.associationend -> Rep_Core.associationend list -> (Rep_OclTerm.OclTerm list * Rep_OclTerm.OclTerm)
|
||||
|
||||
|
||||
|
||||
val modifyAssociationsOfClassifier: Rep_Core.association list ->
|
||||
Rep_Core.association list ->
|
||||
Rep_Core.Classifier -> Rep_Core.Classifier
|
||||
|
||||
|
||||
val withinBounds : Rep_OclTerm.OclTerm -> (int*int) -> Rep_OclTerm.OclTerm
|
||||
val withinAendMultiplicities : Rep_Core.associationend -> Rep_Core.associationend list -> string -> Rep_Core.constraint
|
||||
val injectiveConstraint : Rep_OclType.Path -> Rep_OclType.OclType -> Rep_Core.associationend list -> string -> Rep_Core.constraint
|
||||
val updateClassifiersWithConstraints: Rep_Core.Classifier list ->
|
||||
Rep_OclType.OclType ->
|
||||
Rep_Core.constraint list ->
|
||||
Rep_Core.Classifier list
|
||||
|
||||
|
||||
|
||||
val uid: int ref
|
||||
|
||||
val path_of_aend: Rep_Core.associationend -> Rep_OclType.Path
|
||||
val role_of_aend: Rep_Core.associationend -> string
|
||||
val type_of_aend: Rep_Core.associationend -> Rep_OclType.OclType
|
||||
val association_of_aend: Rep_Core.associationend -> Rep_OclType.Path
|
||||
val multiplicity_of_aend: Rep_Core.associationend -> (int * int) list
|
||||
val package_of_aend: Rep_Core.associationend -> Rep_OclType.Path
|
||||
val name_of_association: Rep_Core.association -> Rep_OclType.Path
|
||||
val package_of_association: Rep_Core.association -> Rep_OclType.Path
|
||||
|
|
@ -124,11 +200,8 @@ structure Transform_Library:TRANSFORM_LIBRARY =
|
|||
struct
|
||||
|
||||
open library
|
||||
open ListPair
|
||||
open List
|
||||
open StringHandling
|
||||
open Rep_OclTerm
|
||||
open Rep_OclType
|
||||
open Rep_OclHelper
|
||||
open Rep_Core
|
||||
|
||||
|
|
@ -138,31 +211,56 @@ val uid = ref 0
|
|||
|
||||
fun nextUid () = (uid := !uid + 1; "_S"^(Int.toString (!uid)))
|
||||
|
||||
fun get_short_name (path:Path):string =
|
||||
List.last path
|
||||
|
||||
fun stripMultiplicities ({name,aends,aclass}:association):association =
|
||||
let
|
||||
fun handleAend {name,aend_type,multiplicity,visibility,
|
||||
ordered,init} =
|
||||
{name=name,
|
||||
aend_type=aend_type,
|
||||
multiplicity=[],
|
||||
visibility=visibility,
|
||||
ordered=ordered,
|
||||
init=init}
|
||||
in
|
||||
{name = name,
|
||||
aends = map handleAend aends,
|
||||
aclass = aclass}
|
||||
end
|
||||
|
||||
fun multiplicity_of_aend ({aend_type,multiplicity,...}:associationend) =
|
||||
multiplicity
|
||||
|
||||
(* (JD) -> Rep_Core? *)
|
||||
fun path_of_aend {name,aend_type,...} = name
|
||||
fun path_of_aend ({name,aend_type,...}:associationend) = name
|
||||
fun name_of_aend ({name,aend_type,...}:associationend) =
|
||||
short_name_of_path name
|
||||
|
||||
fun role_of_aend {name,aend_type,...} = List.last name
|
||||
fun role_of_aend ({name,aend_type,...}:associationend) = List.last name
|
||||
|
||||
(* (JD) -> Rep_Core? *)
|
||||
fun type_of_aend {name,aend_type,...} = aend_type
|
||||
fun type_of_aend ({name,aend_type,...}:associationend) = aend_type
|
||||
|
||||
(* (JD) -> Rep_Core? *)
|
||||
fun association_of_aend {name,aend_type,...} =
|
||||
fun association_of_aend ({name,aend_type,...}:associationend) =
|
||||
List.take(name, (List.length name)-1)
|
||||
|
||||
fun package_of_aend {name,aend_type,...} =
|
||||
fun package_of_aend ({name,aend_type,...}:associationend) =
|
||||
List.take(name, List.length name - 2)
|
||||
|
||||
fun name_of_association {name,aends,aclass} = name
|
||||
fun name_of_association ({name,aends,aclass}:association) = name
|
||||
|
||||
fun package_of_association {name,aends,aclass} =
|
||||
fun package_of_association ({name,aends,aclass}:association) =
|
||||
List.take(name, List.length name - 1)
|
||||
|
||||
(* (JD) -> Rep_Core? *)
|
||||
fun multiplicities_of_aend {aend_type,multiplicity,...} = multiplicity
|
||||
fun multiplicities_of_aend ({aend_type,multiplicity,...}:associationend) =
|
||||
multiplicity
|
||||
|
||||
fun short_name_of_aend {name,aend_type,...} = List.last name
|
||||
fun short_name_of_aend ({name,aend_type,...}:associationend) =
|
||||
short_name_of_path name
|
||||
|
||||
|
||||
fun quantifyForAll variables body =
|
||||
|
|
@ -213,7 +311,103 @@ fun removeAssociations oldAssocs associations =
|
|||
associations (* FIXME *)
|
||||
end
|
||||
|
||||
fun modifyAssociationsOfClassifier newAssociations oldAssociations
|
||||
fun updateClassifiersWithConstraints classifiers oclType constraints =
|
||||
let
|
||||
val (match,rem) = List.partition (fn cls => type_of cls = oclType)
|
||||
classifiers
|
||||
in
|
||||
map (addInvariants constraints) match @ rem
|
||||
end
|
||||
|
||||
fun reachableSet (_:associationend) ([]:associationend list) =
|
||||
error "rep_transform.get_reachableSet: empty source list"
|
||||
| reachableSet (target:associationend) ([source]:associationend list) =
|
||||
let
|
||||
val src_var = Variable(name_of_aend source ,type_of_aend source)
|
||||
in
|
||||
([src_var], ocl_aendcall src_var (path_of_aend target)
|
||||
(type_of_aend target))
|
||||
end
|
||||
| reachableSet (target:associationend) (source::rest) =
|
||||
let
|
||||
val (old_vars,intermediate) = reachableSet target rest
|
||||
val src_var = Variable(name_of_aend source ,type_of_aend source)
|
||||
val new_set = ocl_aendcall src_var (path_of_aend target)
|
||||
(type_of_aend target)
|
||||
in
|
||||
(src_var::old_vars ,ocl_intersection_set new_set intermediate)
|
||||
end
|
||||
|
||||
|
||||
fun withinBounds (set:Rep_OclTerm.OclTerm) ((lower,upper):int*int):Rep_OclTerm.OclTerm =
|
||||
let
|
||||
val size = ocl_size set
|
||||
val lower_lit = Literal (Int.toString lower,Integer)
|
||||
val upper_lit = Literal (Int.toString upper,Integer)
|
||||
val lower_bound = ocl_geq size lower_lit
|
||||
val upper_bound = ocl_leq size upper_lit
|
||||
in
|
||||
ocl_and lower_bound upper_bound
|
||||
end
|
||||
|
||||
fun withinAendMultiplicities targetAend sourceAends name =
|
||||
let
|
||||
val _ = trace function_calls "withinAendMultiplicities\n"
|
||||
val tgtMultiplicities = multiplicities_of_aend targetAend
|
||||
val tgtName = name_of_aend targetAend
|
||||
val tgtType = type_of_aend targetAend
|
||||
val (variables,set) = reachableSet targetAend sourceAends
|
||||
val constrBody = ocl_or_all (map (withinBounds set) tgtMultiplicities)
|
||||
val tgtVariable = Variable(tgtName^nextUid (),tgtType)
|
||||
val allInstances = ocl_allInstances tgtVariable
|
||||
val constrComplete = ocl_forAll allInstances variables constrBody
|
||||
val constraint = (SOME name,constrComplete)
|
||||
in
|
||||
constraint
|
||||
end
|
||||
|
||||
fun injectiveConstraint (source_path:Path) (source_type:OclType) (targets:associationend list) (name:string):constraint =
|
||||
let
|
||||
val source_name = get_short_name source_path
|
||||
val src_var = Variable(source_name,source_type)
|
||||
fun role_bounds src_var aend =
|
||||
let
|
||||
val name = path_of_aend aend
|
||||
val aend_type = type_of_aend aend
|
||||
val set = ocl_aendcall src_var name aend_type
|
||||
val size = ocl_size set
|
||||
val bounds = ocl_eq size (Literal("1",Integer))
|
||||
in
|
||||
bounds
|
||||
end
|
||||
fun role_equals src_var src2_var aend =
|
||||
let
|
||||
val name = path_of_aend aend
|
||||
val aend_type = type_of_aend aend
|
||||
val set = ocl_aendcall src_var name aend_type
|
||||
val size = ocl_size set
|
||||
val match = ocl_eq size (Literal("1",Integer))
|
||||
in
|
||||
match
|
||||
end
|
||||
val roles = map (role_bounds src_var) targets
|
||||
val roles_part = ocl_and_all roles
|
||||
val allInstances = ocl_allInstances src_var
|
||||
val src_var2 = Variable(source_name^"2",source_type)
|
||||
val matches = map (role_equals src_var src_var2) targets
|
||||
val matches_anded = ocl_and_all roles
|
||||
val matches_equal = ocl_eq src_var src_var2
|
||||
val matches_imp = ocl_implies matches_anded matches_equal
|
||||
val allInstances2 = ocl_allInstances src_var2
|
||||
val matches_part = ocl_forAll allInstances2 [src_var2] matches_imp
|
||||
val constr_body = ocl_and roles_part matches_part
|
||||
val constr_complete = ocl_forAll allInstances [src_var] constr_body
|
||||
in
|
||||
(SOME name,constr_complete)
|
||||
end
|
||||
|
||||
fun modifyAssociationsOfClassifier (newAssociations:association list)
|
||||
(oldAssociations:association list)
|
||||
(Class{name,parent,attributes,
|
||||
operations,associations,invariant,
|
||||
stereotypes,interfaces,thyname,
|
||||
|
|
@ -266,12 +460,13 @@ fun modifyAssociationsOfClassifier newAssociations oldAssociations
|
|||
interfaces=interfaces,
|
||||
thyname=thyname}
|
||||
|
||||
fun uniquenessOclConstraint source associations =
|
||||
fun uniquenessOclConstraint (source:Classifier) (associations:association list) =
|
||||
let
|
||||
fun assocAendCalls (self:OclTerm) iter {name,aends,aclass} =
|
||||
fun assocAendCalls (self:OclTerm) (iter:OclTerm) {name,aends,aclass} =
|
||||
let
|
||||
val [{name,aend_type,...}] = filter (fn {aend_type,...} =>
|
||||
aend_type <> Rep_OclHelper.type_of self)
|
||||
val [{name,aend_type,...}] = filter (fn {aend_type,name,multiplicity,ordered,visibility,init} =>
|
||||
Rep_OclHelper.type_of self
|
||||
<> aend_type)
|
||||
aends
|
||||
val selfCall = ocl_aendcall self name (Collection aend_type)
|
||||
val iterCall = ocl_aendcall iter name (Collection aend_type)
|
||||
|
|
@ -291,12 +486,12 @@ fun uniquenessOclConstraint source associations =
|
|||
end
|
||||
|
||||
|
||||
fun binaryAssociations source targets aends=
|
||||
fun binaryAssociations (source:Classifier) (targets:Classifier list) aends=
|
||||
let
|
||||
val _ = trace function_calls "binaryAssociations\n"
|
||||
fun generateAssociation target =
|
||||
let
|
||||
val assocName = package_of_aend source @
|
||||
val assocName = package_of source @
|
||||
["BinaryAssoc"^nextUid ()]
|
||||
val oppAend = {name=assocName@[short_name_of target],
|
||||
aend_type=type_of target,
|
||||
|
|
@ -323,11 +518,12 @@ fun binaryAssociations source targets aends=
|
|||
| order (x::xs) [] =
|
||||
raise InvalidArguments ("binaryAssociations.order:"^
|
||||
"arguments don't agree\n")
|
||||
| order pairs ({name=refName,aend_type,...}::aends) =
|
||||
| order pairs ({name=refName,aend_type,multiplicity,ordered,init,visibility}::aends) =
|
||||
let
|
||||
val ([oppAend],rem) = List.partition (fn (_,{name=oppAendName,
|
||||
aend_type,...}:Rep_Core.associationend) =>
|
||||
oppAendName = refName) pairs
|
||||
aend_type,multiplicity,ordered,visibility,init}) =>
|
||||
oppAendName = refName)
|
||||
pairs
|
||||
in
|
||||
oppAend :: (order rem aends)
|
||||
end
|
||||
|
|
@ -335,25 +531,25 @@ fun binaryAssociations source targets aends=
|
|||
|
||||
val pairs = map generateAssociation targets
|
||||
in
|
||||
unzip (order pairs aends)
|
||||
ListPair.unzip (order pairs aends)
|
||||
end
|
||||
|
||||
fun variableFromAend {name,aend_type,...} =
|
||||
fun variableFromAend ({name,aend_type,...}:associationend) =
|
||||
Variable (toLower (short_name_of_path name)^nextUid (),aend_type)
|
||||
|
||||
fun variableFromClassifier cls =
|
||||
fun variableFromClassifier (cls:Classifier) =
|
||||
Variable (toLower (short_name_of cls)^nextUid () ,type_of cls)
|
||||
|
||||
fun roleToAend source {name,aend_type,...} =
|
||||
fun roleToAend source ({name,aend_type,...}:associationend) =
|
||||
ocl_aendcall source name (Collection aend_type)
|
||||
|
||||
fun fixAends source aends =
|
||||
fun fixAends source (aends:associationend list) =
|
||||
let
|
||||
fun equal (a,b) = ocl_eq a b
|
||||
|
||||
val vars = map variableFromAend aends
|
||||
val roles = map (roleToAend source) aends
|
||||
val body = ocl_and_all (map equal (zip (roles,vars)))
|
||||
val body = ocl_and_all (map equal (ListPair.zip (roles,vars)))
|
||||
val sourceType = Rep_OclHelper.type_of source
|
||||
val ocl = ocl_select (ocl_allInstances
|
||||
(Literal (short_name_of_OclType sourceType,
|
||||
|
|
@ -363,7 +559,7 @@ fun fixAends source aends =
|
|||
(ocl,vars)
|
||||
end
|
||||
|
||||
fun multiplicityOclConstraint source multis binaryAssocs =
|
||||
fun multiplicityOclConstraint source multis oppAends =
|
||||
let
|
||||
val _ = trace function_calls "multiplicityOclConstraint\n"
|
||||
fun bound set (low,high) =
|
||||
|
|
@ -382,15 +578,18 @@ fun multiplicityOclConstraint source multis binaryAssocs =
|
|||
|
||||
val selfVar = self (type_of source)
|
||||
in
|
||||
iterate selfVar multis [] binaryAssocs
|
||||
iterate selfVar multis [] oppAends
|
||||
end
|
||||
|
||||
fun consistencyOclConstraint source reference selfAend roles refRoles =
|
||||
let
|
||||
val _ = trace function_calls "consistencyOclConstraint\n"
|
||||
fun implies selfVar refVar {name=selfPath,aend_type=selfType,...}
|
||||
((role as {name=newPath,aend_type=newType,...}),
|
||||
{name=refPath,aend_type=refType,...}) =
|
||||
fun implies selfVar refVar {name=selfPath,aend_type=selfType,
|
||||
multiplicity,init,visibility,ordered}
|
||||
((role as {name=newPath,aend_type=newType,ordered=ord2,
|
||||
init=init2,multiplicity=mult2,visibility=vis2}),
|
||||
{name=refPath,aend_type=refType,multiplicity=multi3,
|
||||
init=init3,visibility=vis3,ordered=ord3}) =
|
||||
let
|
||||
val var = variableFromAend role
|
||||
val refVarType = Rep_OclHelper.type_of refVar
|
||||
|
|
@ -413,30 +612,33 @@ fun consistencyOclConstraint source reference selfAend roles refRoles =
|
|||
val refVar = variableFromClassifier reference
|
||||
|
||||
in
|
||||
(source, map (implies selfVar refVar selfAend ) (zip (roles,refRoles)))
|
||||
(source, map (implies selfVar refVar selfAend )
|
||||
(ListPair.zip (roles,refRoles)))
|
||||
end
|
||||
|
||||
fun splitNAryAssociation (association as {name as (qualifier::assocName),
|
||||
fun splitNAryAssociation (association as {name=qualifier::assocName,
|
||||
aends,aclass}) classifiers =
|
||||
let
|
||||
val _ = trace function_calls "splitNAryAssociation\n"
|
||||
fun updateClassifier ((clsType,newPaths),classifiers) =
|
||||
fun updateClassifier ((clsType,newAssocs),classifiers) =
|
||||
let
|
||||
val ([cls],rem) = List.partition (fn x => type_of x = clsType )
|
||||
classifiers
|
||||
val modifiedCls = modifyAssociationsOfClassifier newPaths
|
||||
val ([cls],rem) = List.partition (fn x => type_of x = clsType )
|
||||
classifiers
|
||||
val modifiedCls = modifyAssociationsOfClassifier newAssocs
|
||||
[association]
|
||||
cls
|
||||
in
|
||||
modifiedCls::rem
|
||||
modifiedCls::rem
|
||||
end
|
||||
|
||||
|
||||
fun iterate done [] = []
|
||||
| iterate done ((aend as {name,aend_type,multiplicity,ordered,
|
||||
visibility,init})::xs) =
|
||||
visibility,init})::xs) =
|
||||
let
|
||||
fun makeAssoc (sourceAend as {name,aend_type,...})
|
||||
{name=targetName,aend_type=targetType,...} =
|
||||
fun makeAssoc (sourceAend as {name,aend_type,multiplicity,init,
|
||||
ordered,visibility})
|
||||
{name=targetName,aend_type=targetType,init=init2,
|
||||
ordered=ord2,multiplicity=mult2,visibility=vis2} =
|
||||
let
|
||||
val assocPath = package_of_aend sourceAend
|
||||
val assocName = short_name_of_path (association_of_aend
|
||||
|
|
@ -462,9 +664,9 @@ fun splitNAryAssociation (association as {name as (qualifier::assocName),
|
|||
(oppAend,binaryAssoc)
|
||||
end
|
||||
|
||||
val (oppAends,binaryAssocs) = unzip (map (makeAssoc aend)
|
||||
(done@xs))
|
||||
val role = short_name_of name
|
||||
val (oppAends,binaryAssocs) = ListPair.unzip (map (makeAssoc aend)
|
||||
(done@xs))
|
||||
val role = short_name_of_path name
|
||||
in
|
||||
(aend_type,role,oppAends,binaryAssocs)::
|
||||
(iterate (aend::done) xs)
|
||||
|
|
@ -478,9 +680,8 @@ fun splitNAryAssociation (association as {name as (qualifier::assocName),
|
|||
"arguments don't agree\n")
|
||||
| order pairs (cls::clsses) =
|
||||
let
|
||||
val ([oppAend],rem) = List.partition (fn (oppCls,_,_,_) =>
|
||||
name_of oppCls =
|
||||
name_of cls)
|
||||
val ([oppAend],rem) = List.partition (fn (oppType,_,_,_) =>
|
||||
type_of cls = oppType)
|
||||
pairs
|
||||
in
|
||||
oppAend :: (order rem clsses)
|
||||
|
|
@ -498,39 +699,55 @@ fun splitNAryAssociation (association as {name as (qualifier::assocName),
|
|||
|
||||
(* generate new associations *)
|
||||
val pairs = iterate [] aends
|
||||
val (clsses,roleNames,oppAends,splitAssocs) = unzip4 (order pairs
|
||||
val (types,roleNames,oppAends,splitAssocs) = unzip4 (order pairs
|
||||
classifiers)
|
||||
|
||||
(* update associations in classifiers to the new names *)
|
||||
val modifiedClassifiers = foldl updateClassifier classifiers
|
||||
(zip (map type_of clsses,
|
||||
map getPaths splitAssocs))
|
||||
(ListPair.zip (types,splitAssocs))
|
||||
in
|
||||
(modifiedClassifiers, roleNames, oppAends, splitAssocs)
|
||||
end
|
||||
|
||||
(* target type and role name is unqiue, even with reflexive links *)
|
||||
fun matchAends oppRefAends oppAends =
|
||||
fun matchAends (oppRefAends:associationend list) oppAends =
|
||||
let
|
||||
fun findMatch {aend_type=oppAendType,name=oppName,...} =
|
||||
hd (List.filter (fn {aend_type=refAendType,name=refName,
|
||||
...} => oppAendType = refAendType andalso
|
||||
List.last oppName = List.last refName)
|
||||
fun findMatch {aend_type=oppAendType,name=oppName,multiplicity,init,
|
||||
ordered,visibility} =
|
||||
hd (List.filter (fn {aend_type=refAendType,name=refName,ordered,
|
||||
visibility,init,multiplicity} =>
|
||||
oppAendType = refAendType andalso
|
||||
List.last oppName = List.last refName)
|
||||
oppRefAends)
|
||||
in
|
||||
map findMatch oppAends
|
||||
map findMatch oppAends
|
||||
end
|
||||
|
||||
|
||||
(* target type and role name is still unqiue for classifiers and role *)
|
||||
fun matchClassifiers oppRefAends pairs =
|
||||
fun matchClassifiersAtAend aends classifiers =
|
||||
let
|
||||
fun matchClassifier (cls,role) =
|
||||
hd (filter (fn {aend_type,name,...} =>
|
||||
fun match {name,aend_type,ordered,init,multiplicity,visibility} =
|
||||
hd (List.filter (fn cls => type_of cls = aend_type)
|
||||
classifiers)
|
||||
|
||||
fun remove (cls,classifiers) =
|
||||
#2 (List.partition (fn x => type_of x = type_of cls) classifiers)
|
||||
|
||||
val matched = map match aends
|
||||
val rem = foldl remove classifiers matched
|
||||
in
|
||||
(matched,rem)
|
||||
end
|
||||
|
||||
(* target type and role name is still unqiue for classifiers and role *)
|
||||
fun matchAendsAtClassifier oppRefAends pairs =
|
||||
let
|
||||
fun matchAend (cls,role) =
|
||||
hd (filter (fn {aend_type,name,multiplicity,init,
|
||||
ordered,visibility} =>
|
||||
type_of cls = aend_type andalso
|
||||
role = short_name_of_path name) oppRefAends)
|
||||
in
|
||||
map matchClassifier pairs
|
||||
map matchAend pairs
|
||||
end
|
||||
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue