HOL-OCL
/
su4sml
1
0
Fork 0
Code Issues Pull Requests Releases Activity

pending changes from uml2cdl to add tagged values to XMI.Primitive 

git-svn-id: https://projects.brucker.ch/su4sml/svn/infsec-import/trunk/src/su4sml@6215 3260e6d1-4efc-4170-b0a7-36055960796d
This commit is contained in:
Jürgen Doser 2007-02-28 12:33:33 +00:00
parent 97936e32a5
commit dc64206316
4 changed files with 31 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
src/rep_parser.sml
View File

@ -386,20 +386,20 @@ fun transform_classifier t (XMI.Class {xmiid,name,isActive,visibility,isLeaf,
thyname = NONE}
end
| transform_classifier t (XMI.Primitive {xmiid,name,generalizations,
operations,invariant}) =
operations,invariant,taggedValue}) =
let val checked_invariants = filter_exists t invariant
in
Rep.Primitive {name = (* case *) find_classifier_type t xmiid (*of Rep_OclType.Classifier x => x
| _ => raise Option*) ,
parent = NONE, (* FIX *)
operations = map (transform_operation t) operations,
associationends = map (transform_aend t)
(find_aends t xmiid),
invariant = map ((transform_constraint t) o
(find_constraint t)) checked_invariants,
stereotypes = nil, (*FIX *)
interfaces = nil, (* FIX *)
thyname = NONE}
| _ => raise Option*) ,
parent = NONE, (* FIX *)
operations = map (transform_operation t) operations,
associationends = map (transform_aend t)
(find_aends t xmiid),
invariant = map ((transform_constraint t) o
(find_constraint t)) checked_invariants,
stereotypes = nil, (*FIX *)
interfaces = nil, (* FIX *)
thyname = NONE}
end
| transform_classifier t (XMI.Enumeration {xmiid,name,generalizations,
operations,literals,invariant}) =
@ -474,7 +474,8 @@ fun transformXMI ({classifiers,constraints,packages,
xmiid="DummyT",
operations=[],
generalizations=[],
invariant=[]},
invariant=[],
taggedValue=[]},
nil))
(* for some reasons, there are model elements outside of the top-level *)
(* model the xmi-file. So we have to handle them here seperately: *)

4
src/xmi_core.sml
View File

@ -185,7 +185,9 @@ type Primitive = { xmiid: string,
name: string,
operations: Operation list,
generalizations: string list,
invariant: string list}
invariant: string list,
taggedValue: TaggedValue list
}
(* from UML 1.5 Core: --------------------------------------------------------

6
src/xmi_idtable.sml
View File

@ -373,6 +373,9 @@ fun class_taggedvalues_of table (XMI.Class c) =
| class_taggedvalues_of table (XMI.AssociationClass c) =
map (fn x => (find_tagdefinition table (#tag_type x),#dataValue x))
(#taggedValue c)
| class_taggedvalues_of table (XMI.Primitive c) =
map (fn x => (find_tagdefinition table (#tag_type x),#dataValue x))
(#taggedValue c)
| class_taggedvalues_of table _ = error "in class_taggedvalues_of: \
\argument doesn't support tagged values"
@ -384,6 +387,9 @@ fun class_taggedvalue_of table tag (XMI.Class c) =
| class_taggedvalue_of table tag (XMI.AssociationClass c) =
Option.map #2 ((List.find (fn (x,y) => x=tag))
(class_taggedvalues_of table (XMI.AssociationClass c)))
| class_taggedvalue_of table tag (XMI.Primitive c) =
Option.map #2 ((List.find (fn (x,y) => x=tag))
(class_taggedvalues_of table (XMI.Primitive c)))
| class_taggedvalue_of table tag _ = error "in class_taggedvalues_of: \
\argument doesn't support tagged values"

16
src/xmi_parser.sml
View File

@ -819,15 +819,17 @@ fun mkAssociationClass atts tree
fun mkPrimitive atts tree
= XMI.Primitive
{ xmiid = atts |> xmiid,
name = atts |> name,
operations = tree |> get "UML:Classifier.feature"
|> filter "UML:Operation"
name = atts |> name,
operations = tree |> get "UML:Classifier.feature"
|> filter "UML:Operation"
|> map mkOperation,
generalizations = tree |> get "UML:GeneralizableElement.generalization"
generalizations = tree |> get "UML:GeneralizableElement.generalization"
|> map xmiidref,
invariant = tree |> get "UML:ModelElement.constraint"
|> map xmiidref
}
invariant = tree |> get "UML:ModelElement.constraint"
|> map xmiidref,
taggedValue = tree |> get "UML:ModelElement.taggedValue"
|> map mkTaggedValue
}
(* handle IllFormed msg => error ("in mkPrimitive: "^msg)*)
fun mkInterface atts tree