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:
parent
a18ccbf2db
commit
62487325d5
|
@ -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
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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: --------------------------------------------------------
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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))
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue