diff --git a/src/mdr_core.sig b/src/mdr_core.sig index 53a1b74..2bd396c 100644 --- a/src/mdr_core.sig +++ b/src/mdr_core.sig @@ -82,6 +82,7 @@ datatype Classifier = val OclAnyC : Classifier +val normalize : Classifier -> Classifier val name_of : Classifier -> ocl_type.Path val package_of : Classifier -> ocl_type.Path diff --git a/src/mdr_core.sml b/src/mdr_core.sml index 03d1029..543c111 100644 --- a/src/mdr_core.sml +++ b/src/mdr_core.sml @@ -29,14 +29,12 @@ type operation = { name : string, postcondition : (string option * ocl_term.OclTerm) list, arguments : (string * ocl_type.OclType) list, result : ocl_type.OclType, - isQuery : bool - } + isQuery : bool } type associationend = {name : string, aend_type: ocl_type.OclType, multiplicity: (int*int) list, - ordered: bool - } + ordered: bool } datatype Classifier = Class of @@ -79,14 +77,101 @@ datatype Classifier = thyname : string option } +(* convert an association end into the corresponding collection type *) +fun assoc_to_attr_type {name,aend_type,multiplicity,ordered} = + if ordered then ocl_type.Sequence aend_type (* OrderedSet? *) + else ocl_type.Set aend_type + +(* convert an association end into an attribute of the *) +(* corresponding collection type *) +fun assoc_to_attr (assoc:associationend) = (#name assoc,assoc_to_attr_type assoc) +(* 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 = ocl_type.Classifier cls_name + val attr_type = assoc_to_attr_type aend + val attr_name = cls_name@[#name aend] + val literal_a = ocl_term.Literal (Int.toString a, ocl_type.Integer) + val literal_b = ocl_term.Literal (Int.toString b, ocl_type.Integer) + val self = ocl_term.Variable ("self",cls) + val attribute = ocl_term.AttributeCall (self,cls,attr_name,attr_type) + val attribute_size = + ocl_term.OperationCall (attribute,attr_type, + ["oclLib","Collection","size"],[], + ocl_type.Integer) + val lower_bound = + ocl_term.OperationCall (attribute_size,ocl_type.Integer, + ["oclLib","Real",">="], + [(literal_a,ocl_type.Integer)],ocl_type.Boolean) + val upper_bound = + ocl_term.OperationCall (attribute_size,ocl_type.Integer, + ["oclLib","Real","<="], + [(literal_b,ocl_type.Integer)],ocl_type.Boolean) + val equal = + ocl_term.OperationCall (attribute_size,ocl_type.Integer, + ["oclLib","OclAny","="], + [(literal_a,ocl_type.Integer)],ocl_type.Boolean) + in + if a = b then equal + else if b = ~1 then lower_bound + else ocl_term.OperationCall (lower_bound,ocl_type.Boolean, + ["oclLib","Boolean","and"], + [(upper_bound,ocl_type.Boolean)], + ocl_type.Boolean) + 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) *) +(* FIXME: 2. is not implemented yet... *) +fun assoc_to_inv cls_name (aend:associationend) = + let val inv_name = "multiplicity constraint for association end: "^(#name aend) + val range_constraints = map (range_to_inv cls_name aend) + (#multiplicity aend) + fun ocl_or (x,y) = + ocl_term.OperationCall (x,ocl_type.Boolean, + ["oclLib","Boolean","or"], + [(y,ocl_type.Boolean)],ocl_type.Boolean) + in if range_constraints = [] + then (SOME inv_name, ocl_term.Literal ("true",ocl_type.Boolean)) + else (SOME inv_name, foldr1 ocl_or range_constraints) + end + +(* convert association ends into attributes + invariants *) +fun normalize (Class {name,parent,attributes,operations,associationends,invariant, + stereotypes,interfaces,thyname}) = + Class {name = name, + parent = parent, + attributes = (append (map assoc_to_attr associationends) + attributes), + operations = operations, + associationends = nil, + invariant = append (map (assoc_to_inv name) associationends) + invariant, + stereotypes = stereotypes, + interfaces = interfaces, + thyname = thyname } + | normalize (Primitive p) = + (* Primitive's do not have attributes, so we have to convert *) + (* them into Classes... *) + if (#associationends p) = [] + then Primitive p + else normalize (Class {name = #name p, parent = #parent p, attributes=[], + operations = #operations p, invariant = #invariant p, + associationends = #associationends p, + stereotypes = #stereotypes p, + interfaces = #interfaces p, + thyname = #thyname p}) + | normalize c = c val OclAnyC = Class{name=["OclAny"],parent=NONE,attributes=[], operations=[], interfaces=[], invariant=[],stereotypes=[], associationends=[], thyname=NONE} - + fun string_of_path (path:ocl_type.Path) = case path of [] => "" | p => foldr1 (fn (a,b) => a^"."^b) p diff --git a/src/parse_xmi.sml b/src/parse_xmi.sml index 8e4aa8c..fbaa219 100644 --- a/src/parse_xmi.sml +++ b/src/parse_xmi.sml @@ -453,18 +453,19 @@ fun tree2package tree = let val trees = skipOver "UML:Namespace.ownedElement" ((hd o XmlTreeData.getTrees) tree) val atts = XmlTreeData.getAtts tree in - XMI_UML.UMLPackage { xmiid = getXmiId atts, - name = getName atts, - visibility = getVisibility atts, - ownedPackages = (map tree2package - (filterPackages trees)), - ownedClassifiers = (map tree2classifier - (filterClassifiers trees)), - ownedAssociations = getAssociations trees, - ownedGeneralizations = (map tree2generalization - (filterByName "UML:Generalization" - trees)), - ownedConstraints = map tree2constraint (filterConstraints trees) } + XMI_UML.UMLPackage { xmiid = getXmiId atts, + name = getName atts, + visibility = getVisibility atts, + packages = (map tree2package + (filterPackages trees)), + classifiers = (map tree2classifier + (filterClassifiers trees)), + associations = getAssociations trees, + generalizations = (map tree2generalization + (filterByName "UML:Generalization" + trees)), + constraints = map tree2constraint + (filterConstraints trees) } end else raise IllFormed "tree2package" diff --git a/src/xmi2mdr.sml b/src/xmi2mdr.sml index 90bfa37..6574ecf 100644 --- a/src/xmi2mdr.sml +++ b/src/xmi2mdr.sml @@ -27,10 +27,10 @@ structure Xmi2Mdr = struct exception IllFormed -open ocl_type; datatype HashTableEntry = Package of ocl_type.Path - | Type of (ocl_type.OclType * (mdr_core.associationend list)) (* maps xmi.idref to OclType and list of association ends *) + | Type of (ocl_type.OclType * + (XMI_UML.UMLAssociationEnd list)) | Generalization of (string * string) | Constraint of XMI_OCL.OCLConstraint | Stereotype of string @@ -59,11 +59,15 @@ fun find_operation t xmiid = of Operation x => x) handle Option => error ("expected Operation "^xmiid^" in table") +fun find_type t xmiid = + (case valOf (HashTable.find t xmiid) + of Type x => x) + handle Option => error ("expected Type "^xmiid^" in table (find_type)") + fun find_aends t xmiid = (case valOf (HashTable.find t xmiid) of (Type (c,xs)) => xs) - handle Option => error ("expected Type "^xmiid^" in table (aends)") - + handle Option => error ("expected Type "^xmiid^" in table (find_aends)") fun find_variable_dec t xmiid = (case valOf (HashTable.find t xmiid) @@ -119,9 +123,8 @@ fun find_classifier_type t xmiid | ocl_type.Set (ocl_type.Classifier [x]) => ocl_type.Set (find_classifier_type t x) | ocl_type.Bag (ocl_type.Classifier [x]) => ocl_type.Bag (find_classifier_type t x) | ocl_type.OrderedSet (ocl_type.Classifier [x]) => ocl_type.OrderedSet (find_classifier_type t x) - (* | ocl_type.Collection (ocl_type.Classifier [x]) => ocl_type.Collection (find_classifier_type t x) *) end - handle Option => error ("expected Classifier "^xmiid^" in table") + handle Option => error ("expected Classifier "^xmiid^" in table") fun insert_constraint table (c:XMI_OCL.OCLConstraint) = @@ -165,7 +168,9 @@ fun insert_classifier table package_prefix class = else if String.isPrefix "OrderedSet(" name then ocl_type.OrderedSet (ocl_type.Classifier [XMI_UML.classifier_elementtype_of class]) else error ("didn't recognize ocltype "^name) else ocl_type.Classifier path - val aends = nil (* aends = find_aends table id*) + (* This function is called before the associations are handled, *) + (* so we do not have to take care of them now... *) + val aends = nil in HashTable.insert table (id,Type (ocltype,aends)); case class @@ -182,20 +187,6 @@ fun insert_classifier table package_prefix class = | _ => () end -fun insert_package table package_prefix (XMI_UML.UMLPackage{xmiid,name, - ownedClassifiers, - ownedPackages, - ownedGeneralizations, - ownedConstraints,...}) = - let val id = xmiid - val full_name = package_prefix @ [name] - in - map (insert_generalization table ) ownedGeneralizations; - map (insert_constraint table) ownedConstraints; - map (insert_classifier table full_name) ownedClassifiers; - map (insert_package table full_name) ownedPackages; - HashTable.insert table (id,Package full_name) - end fun transform_expression t (XMI_OCL.LiteralExp {symbol,expression_type}) = ocl_term.Literal (symbol,find_classifier_type t expression_type) @@ -257,6 +248,14 @@ fun transform_operation t {xmiid,name,isQuery,parameter,visibility, fun transform_attribute t ({xmiid,name,type_id,changeability,visibility}) = (name,find_classifier_type t type_id) +fun transform_aend t ({xmiid,name,ordering,multiplicity,participant_id, + isNavigable,aggregation,changeability,visibility}) + = {name = name, + aend_type = find_classifier_type t participant_id, + multiplicity = multiplicity, + ordered = if ordering = XMI_UML.Ordered then true else false } + + fun transform_classifier t (XMI_UML.Class {xmiid,name,isActive,visibility,isLeaf, generalizations,attributes,operations, @@ -271,9 +270,10 @@ fun transform_classifier t (XMI_UML.Class {xmiid,name,isActive,visibility,isLeaf | xs => SOME (path_of_classifier (hd xs)), attributes = map (transform_attribute t) attributes, operations = map (transform_operation t) operations, - invariant = map ((transform_constraint t) o - (find_constraint t)) invariant, - associationends = nil, (* FIX *) + invariant = map ((transform_constraint t) o + (find_constraint t)) invariant, + associationends = map (transform_aend t) + (find_aends t xmiid), stereotypes = nil, (* FIX *) interfaces = nil, (* FIX *) thyname = NONE} @@ -283,7 +283,8 @@ fun transform_classifier t (XMI_UML.Class {xmiid,name,isActive,visibility,isLeaf mdr_core.Primitive {name = case find_classifier_type t xmiid of ocl_type.Classifier x => x, parent = NONE, (* FIX *) operations = map (transform_operation t) operations, - associationends = nil, (* FIX *) + associationends = map (transform_aend t) + (find_aends t xmiid), invariant = map ((transform_constraint t) o (find_constraint t)) invariant, stereotypes = nil, (*FIX *) @@ -303,71 +304,96 @@ fun transform_classifier t (XMI_UML.Class {xmiid,name,isActive,visibility,isLeaf | transform_classifier t (_) = error "Not supported Classifier type found." -fun transform_package t (XMI_UML.UMLPackage {xmiid,name,ownedPackages, - ownedClassifiers, - ownedAssociations, - ownedGeneralizations, - ownedConstraints,visibility}) = - append (map (transform_classifier t) ownedClassifiers) - (List.concat (map (transform_package t) ownedPackages)) - - -(* splits an association into a list of two (or more) association ends, *) -(* together with the xmi.id of the "opposite" class" *) -fun split_assoc (assoc:XMI_UML.UMLAssociation) = - let val aends = #connection assoc - fun attach_opposite ae aends = map (fn (x:XMI_UML.UMLAssociationEnd) => (#participant_id x, ae)) - (List.filter (fn x => x <> ae) aends) +(* recursively transform all classes in the package *) +fun transform_package t (XMI_UML.UMLPackage p) = + let (* we do not transform the ocl library *) + val filteredPackages = + filter (fn (XMI_UML.UMLPackage x) => + ((#name x <> "oclLib") andalso (#name x <> "UML_OCL"))) + (#packages p) in - List.concat (map (fn x => attach_opposite x aends) aends) + (map (transform_classifier t) (#classifiers p))@ + (List.concat (map (transform_package t) filteredPackages)) end -fun transform_aend t (id, {xmiid,name,ordering,multiplicity,participant_id, - isNavigable,aggregation,changeability,visibility}) - = (id,{name=name, - aend_type=ocl_type.OclAny (* FIX *), - multiplicity = multiplicity, - ordered = if ordering = XMI_UML.Ordered then true else false }) - - -(* recursively collects all associations in the given list of packages *) -fun collect_associations xs [] = xs - | collect_associations xs - ((XMI_UML.UMLPackage {ownedPackages,ownedAssociations,...})::ps) = - collect_associations (append xs ownedAssociations) (append ownedPackages ps) - -fun transform_toplevel t (XMI_UML.UMLPackage {xmiid,name,ownedPackages, - ownedClassifiers, - ownedAssociations, - ownedGeneralizations, - ownedConstraints,visibility}) = - let val filteredPackages = - filter (fn (XMI_UML.UMLPackage x) => ((#name x <> "oclLib") - andalso (#name x <> "UML_OCL"))) - ownedPackages (* throw away oclLib *) -(* val assocs = collect_associations ownedAssociations filteredPackages - val aends = List.concat (map split_assoc assocs) - val mdr_aends = map (transform_aend t) aends*) - val _ = map (insert_package t nil) ownedPackages - val _ = map (insert_classifier t nil) ownedClassifiers - val cls_in_this_package = map (transform_classifier t) - ownedClassifiers - val cls_in_contained_packages = - List.concat (map (transform_package t) filteredPackages) +(* recursively insert mapping of xmi.id's to model elements into Hashtable *) +fun insert_package table package_prefix (XMI_UML.UMLPackage p) = + let val full_name = package_prefix @ [#name p] in - cls_in_this_package@cls_in_contained_packages + map (insert_generalization table) (#generalizations p); + map (insert_constraint table) (#constraints p); + map (insert_classifier table full_name) (#classifiers p); + map (insert_package table full_name) (#packages p); + HashTable.insert table (#xmiid p,Package full_name) + end + +(* We do not want the name of the model to be part of the package hierarchy, *) +(* therefore we handle the top-level model seperately *) +fun insert_model table (XMI_UML.UMLPackage p) = + let val full_name = nil + in + map (insert_generalization table) (#generalizations p); + map (insert_constraint table) (#constraints p); + map (insert_classifier table full_name) (#classifiers p); + map (insert_package table full_name) (#packages p); + HashTable.insert table (#xmiid p,Package full_name) + end + + +(* split an association into association ends, and put the association ends *) +(* ends into the xmi.id table under the corresponding (i.e., opposite) *) +(* classifier. *) +(* 1. split the association into a list of two (or more) association ends *) +(* 2. pair each association end with the participant_id's of all other *) +(* association ends: when a class is a participant in an association, *) +(* this association end is a feature of all _other_ participants in the *) +(* association *) +(* 3. insert the mapping xmi.id to association end into the hashtable *) +fun transform_assocation t (assoc:XMI_UML.UMLAssociation) = + let val aends = #connection assoc + fun all_others x xs = List.filter (fn y => y <> x) xs + fun pair_with ae aes = + map (fn (x:XMI_UML.UMLAssociationEnd) => (#participant_id x, ae)) aes + val mappings = List.concat (map (fn x => pair_with x (all_others x aends)) aends) + fun add_aend_to_type (id,ae) = + HashTable.insert t (id,Type (find_classifier_type t id, + ae::(find_aends t id))) + in + List.app add_aend_to_type mappings end - + +(* recursively transforms all associations in the package p, *) +fun transform_associations t (XMI_UML.UMLPackage p) = + (map (transform_associations t) (#packages p); + List.app (transform_assocation t) (#associations p)) + +(* transform a UML model into a list of mdr_core classes *) +(* 1. traverse package hierarchy and put xmi.id of all interesting *) +(* model elements into the hashtable *) +(* 2. traverse again to find all associations, transform them into *) +(* association ends and map the correct classes to them *) +(* (We have to handle associations seperately because there is *) +(* no direct link from classes to their association ends in *) +(* the xmi file) *) +(* 3. traverse again, transforming all remaining model elements, *) +(* i.e., classes with their operations, attributes, *) +(* constraints, etc *) fun transformXMI ({classifiers,constraints,packages, stereotypes,variable_declarations}) = let val (xmiid_table: (string,HashTableEntry) HashTable.hash_table) = HashTable.mkTable (HashString.hashString, (op =)) (101, IllFormed) + (* for some reasons, there are model elements outside of the top-level *) + (* model the xmi-file. So we have to handle them here seperately: *) val _ = map (insert_classifier xmiid_table nil) classifiers val _ = map (insert_constraint xmiid_table) constraints val _ = map (insert_stereotype xmiid_table) stereotypes val _ = map (insert_variable_dec xmiid_table) variable_declarations + (* "hd packages" is supposed to be the first model in the xmi-file *) + val model = hd packages in - transform_toplevel xmiid_table (hd packages) + insert_model xmiid_table model; (* fill xmi.id table *) + transform_associations xmiid_table model; (* handle associations *) + map mdr_core.normalize (transform_package xmiid_table model) (* transform classes *) end end diff --git a/src/xmi_uml.sml b/src/xmi_uml.sml index d7c402b..cb54b29 100644 --- a/src/xmi_uml.sml +++ b/src/xmi_uml.sml @@ -469,13 +469,14 @@ type UMLStereotype = {xmiid: string, name: string} datatype UMLPackage = UMLPackage of { xmiid: string, name: string, visibility: VisibilityKind, - ownedPackages: UMLPackage list, - ownedClassifiers: UMLClassifier list, - ownedAssociations: UMLAssociation list, - ownedGeneralizations: UMLGeneralization list, - ownedConstraints: OCLConstraint list } + packages: UMLPackage list, + classifiers: UMLClassifier list, + associations: UMLAssociation list, + generalizations: UMLGeneralization list, + constraints: OCLConstraint list } +(* There may be (are) model elements outside of the UML model *) type XmiContent = {classifiers: UMLClassifier list, constraints: OCLConstraint list, packages: UMLPackage list, diff --git a/src/xmltree_parser.sml b/src/xmltree_parser.sml index 96f5635..450bfec 100644 --- a/src/xmltree_parser.sml +++ b/src/xmltree_parser.sml @@ -104,7 +104,8 @@ structure Parser = Parse (structure Dtd = Dtd structure Resolve = ResolveNull) fun parseXmlTree filename = - let val dtd = Dtd.initDtdTables() + let val _ = OS.FileSys.fileSize filename (* dummy check to see if the file exists...*) + val dtd = Dtd.initDtdTables() (* how to do the following in a clean/portable way? *) val _ = Parser.parseDocument (SOME (Uri.String2Uri ("file:"^(su4sml_home())^"/dummy.xmi"))) @@ -115,3 +116,41 @@ fun parseXmlTree filename = end end + + +structure WriteXmlTree = +struct +open XmlTreeData + +fun writeAttribute stream (name,value) = + TextIO.output (stream, " "^name^"=\""^value^"\"") + +fun writeEndTag stream name = TextIO.output (stream,"\n") + +fun writeStartTag stream tree = + (TextIO.output (stream,"<"^(getElem tree)); + map (writeAttribute stream) (getAtts tree); + TextIO.output (stream,">\n")) + +fun writeIndent stream 0 = () + | writeIndent stream n = (TextIO.output (stream, " "); writeIndent stream (n-1)) + + +fun writeXmlTree' indent stream tree = + let val elemName = getElem tree + in + writeIndent stream indent; + writeStartTag stream tree; + map (writeXmlTree' (indent+1) stream) (getTrees tree); + writeIndent stream indent; + writeEndTag stream elemName + end + +fun writeXmlTree filename tree = + let val stream = TextIO.openOut filename + in + writeXmlTree' 0 stream tree; + TextIO.closeOut stream + end + +end