support for taggedValues

git-svn-id: https://projects.brucker.ch/su4sml/svn/infsec-import/trunk/src/su4sml@3111 3260e6d1-4efc-4170-b0a7-36055960796d
This commit is contained in:
Jürgen Doser 2005-09-21 16:11:45 +00:00
parent a18ccbf2db
commit 62487325d5
6 changed files with 53 additions and 18 deletions

View File

@ -61,7 +61,8 @@ datatype Package = Package of { xmiid : string,
generalizations: Generalization list,
constraints : Constraint list,
stereotypes : Stereotype list,
dependencies : Dependency list}
dependencies : Dependency list,
tag_definitions: TagDefinition list}
end

View File

@ -152,7 +152,7 @@ val filter_named_aends = List.filter (fn {name=SOME _,...}:XMI.AssociationEnd =
fun transform_classifier t (XMI.Class {xmiid,name,isActive,visibility,isLeaf,
generalizations,attributes,operations,
invariant,stereotype,clientDependency,
supplierDependency}) =
supplierDependency,taggedValue}) =
let val parents = map ((find_classifier_type t) o (find_parent t))
generalizations
val filtered_parents = filter (fn x => x <> Rep_OclType.OclAny) parents

View File

@ -281,6 +281,7 @@ type Class = { xmiid : string,
(* xmi.idref to Constraint *)
invariant: string list ,
stereotype: string list,
taggedValue: TaggedValue list,
clientDependency: string list,
supplierDependency: string list}
@ -302,10 +303,10 @@ type Class = { xmiid : string,
* and String.
* --------------------------------------------------------------------------*)
type Primitive = { xmiid: string,
name: string,
operations: Operation list,
generalizations: string list,
invariant: string list}
name: string,
operations: Operation list,
generalizations: string list,
invariant: string list}
(* from UML 1.5 Core: --------------------------------------------------------

View File

@ -43,6 +43,13 @@ datatype HashTableEntry = Package of Rep_OclType.Path
| State of XMI.StateVertex
| Transition of XMI.Transition
| Dependency of XMI.Dependency
| TagDefinition of string
fun find_tagdefinition t xmiid =
(case valOf (HashTable.find t xmiid)
of TagDefinition x => x
| _ => raise Option)
handle Option => raise IllFormed ("expected TagDefinition "^xmiid^" in table")
fun find_state t xmiid =
(case valOf (HashTable.find t xmiid)
@ -227,6 +234,9 @@ XMI.mk_ActivityGraph ag::ags))
fun insert_dependency table dep =
HashTable.insert table (#xmiid dep, Dependency dep)
fun insert_tagdefinition table (td:XMI.TagDefinition) =
HashTable.insert table (#xmiid td, TagDefinition (#name td))
fun insert_classifier table package_prefix class =
let val id = XMI.classifier_xmiid_of class
val name = XMI.classifier_name_of class
@ -267,6 +277,8 @@ fun insert_classifier table package_prefix class =
| _ => ()
end
(* recursively insert mapping of xmi.id's to model elements into Hashtable *)
fun insert_package table package_prefix (XMI.Package p) =
let val full_name = package_prefix @ [#name p]
@ -278,6 +290,7 @@ fun insert_package table package_prefix (XMI.Package p) =
map (insert_package table full_name) (#packages p);
map (insert_activity_graph table) (#activity_graphs p);
map (insert_dependency table) (#dependencies p);
map (insert_tagdefinition table) (#tag_definitions p);
HashTable.insert table (#xmiid p,Package full_name)
end
@ -293,6 +306,7 @@ fun insert_model table (XMI.Package p) =
map (insert_package table full_name) (#packages p);
map (insert_activity_graph table) (#activity_graphs p);
map (insert_dependency table) (#dependencies p);
map (insert_tagdefinition table) (#tag_definitions p);
HashTable.insert table (#xmiid p,Package full_name)
end

View File

@ -356,6 +356,8 @@ val filterActivityGraphs= XmlTree.filter "UML:ActivityGraph"
(* there may be other kinds of dependencies, but we do not parse them atm *)
val filterDependencies = XmlTree.filter "UML:Abstraction"
val filterTagDefinitions = XmlTree.filter "UML:TagDefinition"
(* FIX: other classifiers *)
fun filterClassifiers trees =
filter (fn x => let val elem = XmlTree.tagname_of x in
@ -451,6 +453,25 @@ fun mkAttribute tree =
handle XmlTree.IllFormed msg => raise IllFormed ("in mkAttribute: "^msg)
end
fun mkTaggedValue tree =
let fun f atts trees ={xmiid = getXmiId atts,
dataValue= XmlTree.text_of (hd (XmlTree.children_of (XmlTree.find "UML:TaggedValue.dataValue" trees))),
tag_type = (getXmiIdref o XmlTree.attributes_of o
(XmlTree.find "UML:TagDefinition") o
XmlTree.node_children_of o
(XmlTree.find "UML:TaggedValue.type")) trees
}
in XmlTree.apply_on "UML:TaggedValue" f tree
end
fun mkTagDefinition tree =
let fun f atts trees = { xmiid = getXmiId atts,
name = getName atts,
multiplicity = (mkMultiplicity o hd o
(XmlTree.follow "UML:TagDefinition.multiplicity")) trees }
in XmlTree.apply_on "UML:TagDefinition" f tree
end
fun mkClass atts trees
= XMI.Class { xmiid = getXmiId atts,
name = getName atts,
@ -475,6 +496,9 @@ fun mkClass atts trees
stereotype = (map (getXmiIdref o XmlTree.attributes_of)
(XmlTree.follow "UML:ModelElement.stereotype"
trees)),
taggedValue = (map mkTaggedValue
(XmlTree.follow "UML:ModelElement.taggedValue"
trees)),
clientDependency = (map (getXmiIdref o XmlTree.attributes_of)
(XmlTree.follow "UML:ModelElement.clientDependency"
trees)),
@ -655,16 +679,6 @@ fun mkGuard tree =
end
fun mkTaggedValue tree =
let fun f atts trees ={xmiid = getXmiId atts,
dataValue= "", (* BUG in unserem xml *)
tag_type = (getXmiIdref o XmlTree.attributes_of o
(XmlTree.find "UML:TagDefinition") o
XmlTree.node_children_of o
(XmlTree.find "UML:TaggedValue.type")) trees
}
in XmlTree.apply_on "UML:TaggedValue" f tree
end
fun mkTransition tree =
@ -887,6 +901,8 @@ fun mkPackage tree =
(filterConstraints trees)),
stereotypes = (map mkStereotype
(filterStereotypes trees)),
tag_definitions = (map mkTagDefinition
(filterTagDefinitions trees)),
state_machines = nil,
activity_graphs = nil,
dependencies = (map mkDependency (filterDependencies trees))

View File

@ -30,6 +30,7 @@ sig
datatype Tree = Node of Tag * Tree list
| Text of string
val text_of : Tree -> string
val tag_of : Tree -> Tag
val attributes_of : Tree -> Attribute list
val children_of : Tree -> Tree list
@ -70,8 +71,10 @@ val filter_nodes = List.filter (fn Node x => true
val filter_text = List.filter (fn Text x => true
| _ => false)
fun text_of (Text s) = s
| text_of _ = raise IllFormed "text_of called on Node element"
fun tag_of (Node (tag,trees)) = tag
fun attributes_of (Node ((elem,atts),trees)) = atts
fun children_of (Node ((elem,atts),trees)) = trees