record matching problems for associationends remain
git-svn-id: https://projects.brucker.ch/su4sml/svn/su4sml/trunk@7166 3260e6d1-4efc-4170-b0a7-36055960796d
This commit is contained in:
Martin Bill
parent
92ccc099f1
commit
5c10692c24
|
|
@ -44,25 +44,27 @@ 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,
|
||||
visibility : Visibility
|
||||
}
|
||||
|
||||
type associationend= {name: Rep_OclType.Path (* pathOfAssociation@[aendName]*),
|
||||
aend_type : Rep_OclType.OclType (* participant type *),
|
||||
multiplicity: (int * int) list,
|
||||
ordered: bool,
|
||||
visibility: Visibility,
|
||||
init: Rep_OclTerm.OclTerm option
|
||||
}
|
||||
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,
|
||||
visibility : Visibility
|
||||
}
|
||||
|
||||
type associationend= {
|
||||
name: Rep_OclType.Path (* pathOfAssociation@[aendName]*),
|
||||
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,
|
||||
|
|
@ -72,16 +74,17 @@ type attribute = {
|
|||
init : Rep_OclTerm.OclTerm option
|
||||
}
|
||||
|
||||
type association = { name: Rep_OclType.Path (* pathOfPackage@[assocName] *),
|
||||
aends: associationend list,
|
||||
aclass: Rep_OclType.Path option
|
||||
}
|
||||
|
||||
type association = {
|
||||
name: Rep_OclType.Path (* pathOfPackage@[assocName] *),
|
||||
aends: associationend list,
|
||||
aclass: Rep_OclType.Path option
|
||||
}
|
||||
|
||||
type constraint = (string option * Rep_OclTerm.OclTerm)
|
||||
|
||||
|
||||
datatype Classifier =
|
||||
Class of
|
||||
{ name : Rep_OclType.OclType,
|
||||
Class of
|
||||
{ name : Rep_OclType.OclType,
|
||||
parent : Rep_OclType.OclType option,
|
||||
attributes : attribute list,
|
||||
operations : operation list,
|
||||
|
|
@ -91,8 +94,8 @@ datatype Classifier =
|
|||
interfaces : Rep_OclType.OclType list,
|
||||
thyname : string option,
|
||||
activity_graphs : Rep_ActivityGraph.ActivityGraph list
|
||||
}
|
||||
| AssociationClass of (* billk_tag *)
|
||||
}
|
||||
| AssociationClass of
|
||||
{ name : Rep_OclType.OclType,
|
||||
parent : Rep_OclType.OclType option,
|
||||
attributes : attribute list,
|
||||
|
|
@ -101,25 +104,19 @@ datatype Classifier =
|
|||
stereotypes : string list,
|
||||
interfaces : Rep_OclType.OclType list,
|
||||
thyname : string option,
|
||||
activity_graphs : Rep_ActivityGraph.ActivityGraph list,
|
||||
(* visibility : Visibility,
|
||||
isActive : bool,
|
||||
generalizations : string list,
|
||||
taggedValue : TaggedValue list,
|
||||
clientDependency : string list,
|
||||
supplierDependency : string list,
|
||||
*) associations: Rep_OclType.Path list,
|
||||
activity_graphs : Rep_ActivityGraph.ActivityGraph list,
|
||||
associations: Rep_OclType.Path list,
|
||||
association: Rep_OclType.Path
|
||||
}
|
||||
| Interface of (* not supported yet *)
|
||||
| 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 of (* not really supported yet? *)
|
||||
}
|
||||
| Enumeration (* not really supported yet? *) of
|
||||
{ name : Rep_OclType.OclType,
|
||||
parent : Rep_OclType.OclType option,
|
||||
operations : operation list,
|
||||
|
|
@ -128,8 +125,8 @@ datatype Classifier =
|
|||
stereotypes : string list,
|
||||
interfaces : Rep_OclType.OclType list,
|
||||
thyname : string option
|
||||
}
|
||||
| Primitive of (* not really supported yet *)
|
||||
}
|
||||
| Primitive (* not really supported yet *) of
|
||||
{ name : Rep_OclType.OclType,
|
||||
parent : Rep_OclType.OclType option,
|
||||
operations : operation list,
|
||||
|
|
@ -138,7 +135,7 @@ datatype Classifier =
|
|||
stereotypes : string list,
|
||||
interfaces : Rep_OclType.OclType list,
|
||||
thyname : string option
|
||||
}
|
||||
}
|
||||
| Template of
|
||||
{ parameter : Rep_OclType.OclType,
|
||||
classifier : Classifier
|
||||
|
|
@ -148,7 +145,7 @@ type transform_model = (Classifier list * association list)
|
|||
|
||||
val OclAnyC : Classifier
|
||||
|
||||
val joinModel : transform_model -> transform_model -> transform_model
|
||||
val joinModel : transform_model -> transform_model -> transform_model
|
||||
|
||||
val normalize : association list -> Classifier -> Classifier
|
||||
val normalize_init : Classifier -> Classifier
|
||||
|
|
@ -192,8 +189,6 @@ val operation_of : Classifier list -> Rep_OclType.Path -> operation optio
|
|||
val topsort_cl : Classifier list -> Classifier list
|
||||
val connected_classifiers_of : association list -> Classifier -> Classifier list -> Classifier list
|
||||
|
||||
(* billk_tag *)
|
||||
(* changed assoc to aend, since associations are now part of the model *)
|
||||
val aend_to_attr_type : associationend -> Rep_OclType.OclType
|
||||
|
||||
val update_thyname : string -> Classifier -> Classifier
|
||||
|
|
@ -222,15 +217,17 @@ open Rep_OclType
|
|||
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,
|
||||
visibility : Visibility,
|
||||
scope : Scope }
|
||||
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,
|
||||
visibility : Visibility,
|
||||
scope : Scope
|
||||
}
|
||||
|
||||
type associationend = {
|
||||
name : Rep_OclType.Path,
|
||||
|
|
@ -251,10 +248,11 @@ type attribute = {
|
|||
}
|
||||
|
||||
|
||||
type association = { name: Rep_OclType.Path,
|
||||
aends: associationend list,
|
||||
aclass: Rep_OclType.Path option
|
||||
}
|
||||
type association = {
|
||||
name: Rep_OclType.Path,
|
||||
aends: associationend list,
|
||||
aclass: Rep_OclType.Path option
|
||||
}
|
||||
|
||||
type constraint = (string option * Rep_OclTerm.OclTerm)
|
||||
|
||||
|
|
@ -271,7 +269,7 @@ datatype Classifier =
|
|||
thyname : string option,
|
||||
activity_graphs : Rep_ActivityGraph.ActivityGraph list
|
||||
}
|
||||
| AssociationClass of (* billk_tag *)
|
||||
| AssociationClass of
|
||||
{ name : Rep_OclType.OclType,
|
||||
parent : Rep_OclType.OclType option,
|
||||
attributes : attribute list,
|
||||
|
|
@ -281,13 +279,7 @@ datatype Classifier =
|
|||
interfaces : Rep_OclType.OclType list,
|
||||
thyname : string option,
|
||||
activity_graphs : Rep_ActivityGraph.ActivityGraph list,
|
||||
(* visibility : Visibility,
|
||||
isActive : bool,
|
||||
generalizations : string list,
|
||||
taggedValue : TaggedValue list,
|
||||
clientDependency : string list,
|
||||
supplierDependency : string list,
|
||||
*) associations: Rep_OclType.Path list,
|
||||
associations: Rep_OclType.Path list,
|
||||
association: Rep_OclType.Path
|
||||
}
|
||||
| Interface of (* not supported yet *)
|
||||
|
|
|
|||
|
|
@ -51,6 +51,7 @@ sig
|
|||
| Collection of OclType
|
||||
| Classifier of Path | OclVoid | DummyT | TemplateParameter of string
|
||||
|
||||
val short_name_of_OclType: OclType -> string
|
||||
val path_of_OclType : OclType -> Path
|
||||
val collection_type_of_OclType : OclType -> OclType
|
||||
val string_of_OclType : OclType -> string
|
||||
|
|
@ -159,11 +160,13 @@ fun collection_type_of_OclType (Set t) = t
|
|||
|
||||
fun string_of_OclType t = string_of_OclType' "." t
|
||||
|
||||
|
||||
fun path_of_OclType (Classifier p) = p
|
||||
| path_of_OclType (TemplateParameter p) = [] (* FIXME *)
|
||||
| path_of_OclType x = ["oclLib",string_of_OclType x]
|
||||
|
||||
fun short_name_of_OclType t = (List.last o path_of_OclType) t
|
||||
|
||||
|
||||
(** Convert OclType to a string with :: in between *)
|
||||
fun string_of_OclType_colon t = string_of_OclType' "::" t
|
||||
|
||||
|
|
|
|||
|
|
@ -131,13 +131,7 @@ val multiplicities_of_aend : Rep_Core.associationend -> (int*int) list
|
|||
* @return all but the last part of qualifiedName
|
||||
*)
|
||||
val get_qualifier : Rep_OclType.Path -> Rep_OclType.Path
|
||||
(**
|
||||
* returns the last part of the (fully) qualified name.
|
||||
* @params {qualifiedName}
|
||||
* @param qualifiedName path denoting a name
|
||||
* @return the last part of qualifiedName
|
||||
*)
|
||||
val get_short_name : Rep_OclType.Path -> string
|
||||
|
||||
(**
|
||||
* Remove all multiplicities from the association
|
||||
* @params {assoc}
|
||||
|
|
@ -200,44 +194,6 @@ exception InvalidArguments of string
|
|||
§ ***********************************)
|
||||
val triv_expr = Rep_OclTerm.Literal ("true",Rep_OclType.Boolean)
|
||||
|
||||
(* (JD) -> Rep_Core? *)
|
||||
fun path_of_aend (aend:associationend) =
|
||||
#name aend
|
||||
|
||||
fun role_of_aend (aend:associationend) =
|
||||
List.first o #name aend
|
||||
|
||||
(* (JD) -> Rep_Core? *)
|
||||
fun type_of_aend (aend:associationend) =
|
||||
#aend_type aend
|
||||
|
||||
(* (JD) -> Rep_Core? *)
|
||||
fun association_of_aend (aend:associationend) =
|
||||
let
|
||||
val name = #name aend
|
||||
in
|
||||
List.take(name, (List.length name)-1)
|
||||
end
|
||||
|
||||
(* (JD) -> Rep_Core? *)
|
||||
fun name_of_aend (aend:associationend):string =
|
||||
List.last (#name aend)
|
||||
|
||||
fun package_of_association {name=package@[assoc],aends,aclass} =
|
||||
package
|
||||
|
||||
(* (JD) -> Rep_Core? *)
|
||||
fun multiplicities_of_aend (aend:associationend):(int*int)list =
|
||||
#multiplicity aend
|
||||
|
||||
(** chop-off the last part of the path *)
|
||||
(* (JD) -> Rep_OclType? *)
|
||||
fun get_qualifier (path:Path):Path =
|
||||
List.take (path,List.length path - 1)
|
||||
|
||||
fun short_name_of_aend {name,aend_type,...}:string =
|
||||
List.last name
|
||||
|
||||
(* (JD) -> Rep_OclType? *)
|
||||
fun get_short_name (path:Path):string =
|
||||
List.last path
|
||||
|
|
|
|||
|
|
@ -19,7 +19,7 @@ val uniquenessOclConstraint : Rep_Core.Classifier ->
|
|||
*)
|
||||
val multiplicityOclConstraint: Rep_Core.Classifier -> (int*int) list list ->
|
||||
Rep_Core.association list ->
|
||||
Rep_Core.constraint
|
||||
Rep_Core.constraint list
|
||||
|
||||
(**
|
||||
* @params {association,assocMembers}
|
||||
|
|
@ -87,6 +87,9 @@ val nextUid: unit -> string
|
|||
*)
|
||||
val newDummyClass: Rep_OclType.Path -> Rep_Core.Classifier
|
||||
|
||||
val fixAends: Rep_OclTerm.OclTerm -> Rep_Core.associationend list
|
||||
-> (Rep_OclTerm.OclTerm * Rep_OclTerm.OclTerm list)
|
||||
|
||||
val isPureNAryAssoc: Rep_Core.association -> bool
|
||||
|
||||
(**
|
||||
|
|
@ -101,6 +104,10 @@ val isPureBinAssoc : Rep_Core.association -> bool
|
|||
|
||||
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
|
||||
|
||||
exception InvalidArguments of string
|
||||
end
|
||||
|
||||
|
|
@ -123,6 +130,36 @@ val uid = ref 0
|
|||
|
||||
fun nextUid () = (uid := !uid + 1; "_S"^(Int.toString (!uid)))
|
||||
|
||||
|
||||
(* (JD) -> Rep_Core? *)
|
||||
fun path_of_aend {name,aend_type,...} = name
|
||||
|
||||
fun role_of_aend {name,aend_type,...} = List.last name
|
||||
|
||||
(* (JD) -> Rep_Core? *)
|
||||
fun type_of_aend {name,aend_type,...} = aend_type
|
||||
|
||||
(* (JD) -> Rep_Core? *)
|
||||
fun association_of_aend {name,aend_type,...} =
|
||||
List.take(name, (List.length name)-1)
|
||||
|
||||
fun package_of_aend {name,aend_type,...} =
|
||||
List.take(name, List.length name - 2)
|
||||
|
||||
fun name_of_association {name,aends,aclass} =
|
||||
name
|
||||
|
||||
fun package_of_association {name,aends,aclass} =
|
||||
List.take(name, List.length name - 1)
|
||||
|
||||
(* (JD) -> Rep_Core? *)
|
||||
fun multiplicities_of_aend (aend:associationend):(int*int)list =
|
||||
#multiplicity aend
|
||||
|
||||
fun short_name_of_aend {name,aend_type,...}:string =
|
||||
List.last name
|
||||
|
||||
|
||||
fun quantifyForAll variables body =
|
||||
let
|
||||
fun quantify (variable as Variable(_,varType),body) =
|
||||
|
|
@ -226,10 +263,10 @@ fun modifyAssociationsOfClassifier newAssociations oldAssociations
|
|||
|
||||
fun uniquenessOclConstraint source associations =
|
||||
let
|
||||
fun assocAendCalls self iter {name,aends,aclass} =
|
||||
fun assocAendCalls (self:OclTerm) iter {name,aends,aclass} =
|
||||
let
|
||||
val [{name,aend_type,...}] = filter (fn {aend_type,...} =>
|
||||
aend_type <> type_of self)
|
||||
aend_type <> Rep_OclHelper.type_of self)
|
||||
aends
|
||||
val selfCall = ocl_aendcall self name (Collection aend_type)
|
||||
val iterCall = ocl_aendcall iter name (Collection aend_type)
|
||||
|
|
@ -254,9 +291,9 @@ fun binaryAssociations source targets aends=
|
|||
val _ = trace function_calls "binaryAssociations\n"
|
||||
fun generateAssociation target =
|
||||
let
|
||||
val assocName = path_of_package source @
|
||||
val assocName = package_of_aend source @
|
||||
["BinaryAssoc"^nextUid ()]
|
||||
val oppAend = {name=assocName#[short_name_of target],
|
||||
val oppAend = {name=assocName@[short_name_of target],
|
||||
aend_type=type_of target,
|
||||
multiplicity=[(1,1)],
|
||||
ordered=false,
|
||||
|
|
@ -264,15 +301,15 @@ fun binaryAssociations source targets aends=
|
|||
init=NONE}
|
||||
in
|
||||
({name= assocName,
|
||||
aends=[{name=assocName@ [short_name_of source],
|
||||
aend_type=type_of source,
|
||||
multiplicity=[],
|
||||
ordered=false,
|
||||
visibility=XMI_DataTypes.public,
|
||||
init=NONE},
|
||||
oppAend],
|
||||
aclass=NONE}
|
||||
,oppAend)
|
||||
aends=[{name=assocName@ [short_name_of source],
|
||||
aend_type=type_of source,
|
||||
multiplicity=[],
|
||||
ordered=false,
|
||||
visibility=XMI_DataTypes.public,
|
||||
init=NONE},
|
||||
oppAend],
|
||||
aclass=NONE},
|
||||
oppAend)
|
||||
end
|
||||
|
||||
fun order [] (x::xs) =
|
||||
|
|
@ -281,24 +318,26 @@ fun binaryAssociations source targets aends=
|
|||
| order (x::xs) [] =
|
||||
raise InvalidArguments ("binaryAssociations.order:"^
|
||||
"arguments don't agree\n")
|
||||
| order pairs ({name,aend_type,...}::aends) =
|
||||
| order pairs ({name=refName,aend_type,...}::aends) =
|
||||
let
|
||||
val (oppAend,rem) = List.partition (fn (_,{oppAendName,...}) =>
|
||||
oppAendName = name) pairs
|
||||
val ([oppAend],rem) = List.partition (fn (_,{name=oppAendName,
|
||||
aend_type,...}) =>
|
||||
oppAendName = refName) pairs
|
||||
in
|
||||
if length oppAend = 1 then oppAend :: order rem aends
|
||||
else raise InvalidArguments ("binaryAssociations.order:"^
|
||||
"arguments don't agree\n")
|
||||
oppAend :: (order rem aends)
|
||||
end
|
||||
|
||||
|
||||
val pairs = map generateAssociation targets
|
||||
in
|
||||
unzip o order pairs aends
|
||||
unzip (order pairs aends)
|
||||
end
|
||||
|
||||
fun variableFromAend {name,aend_type,...} =
|
||||
Variable((toLower o get_short_name name)^nextUid (),aend_type)
|
||||
Variable (toLower (short_name_of_path name)^nextUid (),aend_type)
|
||||
|
||||
fun variableFromClassifier cls =
|
||||
Variable (toLower (short_name_of cls)^nextUid () ,type_of cls)
|
||||
|
||||
fun roleToAend source {name,aend_type,...} =
|
||||
ocl_aendcall source name (Collection aend_type)
|
||||
|
|
@ -309,8 +348,11 @@ fun fixAends source aends =
|
|||
|
||||
val vars = map variableFromAend aends
|
||||
val roles = map (roleToAend source) aends
|
||||
val body = ocl_and_all (map equal (ListPair.zip roles vars))
|
||||
val ocl = ocl_select (ocl_allInstances (Literal (type_of source)))
|
||||
val body = ocl_and_all (map equal (zip (roles,vars)))
|
||||
val sourceType = Rep_OclHelper.type_of source
|
||||
val ocl = ocl_select (ocl_allInstances
|
||||
(Literal (short_name_of_OclType sourceType,
|
||||
sourceType)))
|
||||
source body
|
||||
in
|
||||
(ocl,vars)
|
||||
|
|
@ -318,10 +360,10 @@ fun fixAends source aends =
|
|||
|
||||
fun multiplicityOclConstraint source multis binaryAssocs =
|
||||
let
|
||||
val _ = trace_function_calls "multiplicityOclConstraint\n"
|
||||
val _ = trace function_calls "multiplicityOclConstraint\n"
|
||||
fun bound set (low,high) =
|
||||
ocl_and (ocl_leq (ocl_size set) high)
|
||||
(ocl_geq (ocl_size set) low)
|
||||
ocl_and (ocl_leq (ocl_size set) (Literal(Int.toString high,Integer)))
|
||||
(ocl_geq (ocl_size set) (Literal(Int.toString low,Integer)))
|
||||
|
||||
fun iterate _ [] done [] = []
|
||||
| iterate source (multi::ys) done (a::xs) =
|
||||
|
|
@ -330,7 +372,7 @@ fun multiplicityOclConstraint source multis binaryAssocs =
|
|||
val body = ocl_or_all (map (bound set) multi)
|
||||
in
|
||||
(SOME "MultiplicityConstraint",quantifyForAll vars body)::
|
||||
(iterate self ys (a::done) xs)
|
||||
(iterate source ys (a::done) xs)
|
||||
end
|
||||
|
||||
val selfVar = self (type_of source)
|
||||
|
|
@ -341,30 +383,32 @@ fun multiplicityOclConstraint source multis binaryAssocs =
|
|||
fun consistencyOclConstraint source reference selfAend roles refRoles =
|
||||
let
|
||||
val _ = trace function_calls "consistencyOclConstraint\n"
|
||||
fun implies self refer {name=selfPath,aend_type=selfType,...}
|
||||
fun implies selfVar refVar {name=selfPath,aend_type=selfType,...}
|
||||
((role as {name=newPath,aend_type=newType,...}),
|
||||
{name=refPath,aend_type=refType,...}) =
|
||||
let
|
||||
val var = variableFromAend role
|
||||
val refLit = Literal (type_of refer)
|
||||
val link = ocl_exists (ocl_aendcall self newPath
|
||||
val refVarType = Rep_OclHelper.type_of refVar
|
||||
val refLit = Literal (short_name_of_OclType refVarType,
|
||||
refVarType)
|
||||
val link = ocl_exists (ocl_aendcall selfVar newPath
|
||||
(Collection newType))
|
||||
var ocl_true
|
||||
val refOther = ocl_aendcall refer refPath (Collection newType)
|
||||
val refSelf = ocl_aendcall refer selfPath (Collection selfType)
|
||||
val included = ocl_exists (ocl_allInstances refLit) refer
|
||||
(ocl_and (ocl_eq refOther refer)
|
||||
(ocl_eq refSelf self))
|
||||
val refOther = ocl_aendcall refVar refPath (Collection newType)
|
||||
val refSelf = ocl_aendcall refVar selfPath (Collection selfType)
|
||||
val included = ocl_exists (ocl_allInstances refLit) refVar
|
||||
(ocl_and (ocl_eq refOther refVar)
|
||||
(ocl_eq refSelf selfVar))
|
||||
val body = ocl_implies link included
|
||||
in
|
||||
(SOME "ConsistencyConstraint", quantifyForAll [var] body)
|
||||
end
|
||||
|
||||
val self = self (type_of source)
|
||||
val refer = variableFromClassifier reference
|
||||
val selfVar = self (type_of source)
|
||||
val refVar = variableFromClassifier reference
|
||||
|
||||
in
|
||||
(source, map (self refer selfAend ) (zip roles refRoles))
|
||||
(source, map (implies selfVar refVar selfAend ) (zip (roles,refRoles)))
|
||||
end
|
||||
|
||||
fun splitNAryAssociation (association as {name as (qualifier::assocName),
|
||||
|
|
@ -379,19 +423,20 @@ fun splitNAryAssociation (association as {name as (qualifier::assocName),
|
|||
[association]
|
||||
cls
|
||||
in
|
||||
modifiedCls@rem
|
||||
modifiedCls::rem
|
||||
end
|
||||
|
||||
fun iterate done [] = []
|
||||
| iterate done (aend as {name,aend_type,...}::xs) =
|
||||
| iterate done ((aend as {name,aend_type,...})::xs) =
|
||||
let
|
||||
fun makeAssoc (sourceAend as {name,aend_type,...})
|
||||
{name=targetName,aend_type=targetType,...} =
|
||||
let
|
||||
val assocPath = package_of_aend sourceAend
|
||||
val assocName = association_of_aend sourceAend
|
||||
val assocName = short_name_of_path (association_of_aend
|
||||
sourceAend)
|
||||
val role = role_of_aend sourceAend
|
||||
val newAssocName = assocPath@[assocName^nextUid]
|
||||
val newAssocName = assocPath@[assocName^ nextUid ()]
|
||||
val oppAend = {name=newAssocName@[List.last targetName],
|
||||
aend_type=targetType,
|
||||
multiplicity=[],
|
||||
|
|
@ -411,8 +456,8 @@ fun splitNAryAssociation (association as {name as (qualifier::assocName),
|
|||
(oppAend,binaryAssoc)
|
||||
end
|
||||
|
||||
val (oppAends,binaryAssocs) = unzip o map (makeAssoc aend)
|
||||
(done@xs)
|
||||
val (oppAends,binaryAssocs) = unzip (map (makeAssoc aend)
|
||||
(done@xs))
|
||||
val role = short_name_of name
|
||||
in
|
||||
(aend_type,role,oppAends,binaryAssocs)::
|
||||
|
|
@ -427,35 +472,33 @@ 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,_,_,_) =>
|
||||
val ([oppAend],rem) = List.partition (fn (oppCls,_,_,_) =>
|
||||
name_of oppCls =
|
||||
name_of cls)
|
||||
pairs
|
||||
in
|
||||
if length oppAend = 1 then oppAend :: order rem clsses
|
||||
else raise InvalidArguments ("splitNAryAssociation.order:"^
|
||||
"arguments don't agree\n")
|
||||
oppAend :: (order rem clsses)
|
||||
end
|
||||
|
||||
fun unzip4 [] = []
|
||||
fun unzip4 [] = ([],[],[],[])
|
||||
| unzip4 ((a,b,c,d)::xs) =
|
||||
let
|
||||
val (az,bs,cs,ds) = unzip xs
|
||||
val (az,bs,cs,ds) = unzip4 xs
|
||||
in
|
||||
(a::az,b::bs,c::cs,d::ds)
|
||||
end
|
||||
|
||||
fun getPaths assocs = map name_of_assoc assocs
|
||||
fun getPaths assocs = map name_of_association assocs
|
||||
|
||||
(* generate new associations *)
|
||||
val pairs = iterate classifiers [] aends
|
||||
val (clsses,roleNames,oppAends,splitAssocs) = unzip4 o order pairs
|
||||
classifiers
|
||||
val pairs = iterate [] aends
|
||||
val (clsses,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))
|
||||
(zip (map type_of clsses,
|
||||
map getPaths splitAssocs))
|
||||
in
|
||||
(modifiedClassifiers, roleNames, oppAends, splitAssocs)
|
||||
end
|
||||
|
|
@ -464,12 +507,12 @@ fun splitNAryAssociation (association as {name as (qualifier::assocName),
|
|||
fun matchAends oppRefAends oppAends =
|
||||
let
|
||||
fun findMatch {aend_type=oppAendType,name=oppName,...} =
|
||||
hd o filter (fn {aend_type=refAendType,name=refName,
|
||||
...} => oppAendType = refAendType andalso
|
||||
List.last oppName = List.last refName)
|
||||
oppRefAends
|
||||
hd (List.filter (fn {aend_type=refAendType,name=refName,
|
||||
...} => oppAendType = refAendType andalso
|
||||
List.last oppName = List.last refName)
|
||||
oppRefAends)
|
||||
in
|
||||
map findMatch oppAends
|
||||
map findMatch oppAends
|
||||
end
|
||||
|
||||
|
||||
|
|
@ -477,9 +520,9 @@ fun matchAends oppRefAends oppAends =
|
|||
fun matchClassifiers oppRefAends pairs =
|
||||
let
|
||||
fun matchClassifier (cls,role) =
|
||||
hd (filter (fn {aendType,name,...} =>
|
||||
type_of cls = aendType andalso
|
||||
role = List.last name) oppRefAends)
|
||||
hd (filter (fn {aend_type,name,...} =>
|
||||
type_of cls = aend_type andalso
|
||||
role = short_name_of_path name) oppRefAends)
|
||||
in
|
||||
map matchClassifier pairs
|
||||
end
|
||||
|
|
@ -491,6 +534,12 @@ fun binaryAssociations source targets aends =
|
|||
fun generateAssociation target =
|
||||
let
|
||||
val assocName = package_of source@["BinaryAssoc"^(nextUid ())]
|
||||
val targetAend = {name=assocName@[short_name_of target],
|
||||
aend_type=type_of target,
|
||||
multiplicity=[(1,1)],
|
||||
ordered=false,
|
||||
visibility=XMI_DataTypes.public,
|
||||
init=NONE}
|
||||
in
|
||||
({name= assocName,
|
||||
aends=[{name=assocName@[short_name_of source],
|
||||
|
|
@ -499,20 +548,9 @@ fun binaryAssociations source targets aends =
|
|||
ordered=false,
|
||||
visibility=XMI_DataTypes.public,
|
||||
init=NONE},
|
||||
{name=assocName@[short_name_of target],
|
||||
aend_type=type_of target,
|
||||
multiplicity=[(1,1)],
|
||||
ordered=false,
|
||||
visibility=XMI_DataTypes.public,
|
||||
init=NONE}],
|
||||
targetAend],
|
||||
aclass=NONE},
|
||||
{name=assocName@[short_name_of target],
|
||||
aend_type=type_of target,
|
||||
multiplicity=[(1,1)],
|
||||
ordered=false,
|
||||
visibility=XMI_DataTypes.public,
|
||||
init=NONE}
|
||||
)
|
||||
targetAend)
|
||||
end
|
||||
|
||||
val (assocs,refAends) = ListPair.unzip (map generateAssociation targets)
|
||||
|
|
|
|||
Loading…
Reference in New Issue