diff --git a/src/ROOT.ML b/src/ROOT.ML index c17c3c0..d6b0cdd 100644 --- a/src/ROOT.ML +++ b/src/ROOT.ML @@ -64,7 +64,10 @@ use "rep.sml"; - only "interesting" parts were represented - structural simplifications whereever needed for our applications. - - Layout Information skipped. *) + - Layout Information skippedi + - the structure is oriented towards UML 1.5 + (although the supported Poseidon is apparantly based + on Version 1.4 or something ...). *) use "xmi_ocl.sml"; use "xmi_core.sml"; use "xmi_state_machines.sml"; diff --git a/src/library.sml b/src/library.sml index 8eb620a..71e39d7 100644 --- a/src/library.sml +++ b/src/library.sml @@ -65,6 +65,8 @@ fun foldr1 f l = | itr (x::l) = f(x, itr l) in itr l end; +fun ap_some f (SOME x) = SOME(f x) + |ap_some f NONE = NONE fun separate s (x :: (xs as _ :: _)) = x :: s :: separate s xs | separate _ xs = xs; diff --git a/src/xmi_activity_graphs.sml b/src/xmi_activity_graphs.sml index 212a3e2..0b018e8 100644 --- a/src/xmi_activity_graphs.sml +++ b/src/xmi_activity_graphs.sml @@ -39,7 +39,7 @@ open XMI_StateMachines datatype ActivityGraph = mk_ActivityGraph of {xmiid : string, contextxmiid : string, - is_specification : bool, + isSpecification : bool, top : StateVertex, partition : (string * StateVertex_Id list) list, transitions : Transition list} diff --git a/src/xmi_state_machines.sml b/src/xmi_state_machines.sml index 5b2ba8c..73d0fe9 100644 --- a/src/xmi_state_machines.sml +++ b/src/xmi_state_machines.sml @@ -42,17 +42,25 @@ open XMI_Core XMI_CommonBehavior type StateVertex_Id = string type Transition_Id = string - -datatype Action = create - | call - | return - | send - | terminate - | uninterpreted - | destroy - | sequence -datatype Guard = mk_Guard of {expression : Rep_OclTerm.OclTerm} +datatype Procedure = mk_Procedure of + {xmiid : string, + isSpecification : bool, + name : string, + isAsynchronous : bool, + language : string, + body : string, + expression : string list + (* method : Method list, NOT YET IMPLEMENTED *) + (* isList : bool NOT SUPPORTED BY POSEIDON *)} + +datatype Guard = mk_Guard of {xmiid : string, + isSpecification : bool, + name : string, + visibility : VisibilityKind, + language : string, + body : string, + expression : string list} datatype Event = SignalEvent of Parameter list | CallEvent of Parameter list @@ -61,13 +69,13 @@ datatype Event = SignalEvent of Parameter list datatype Transition = mk_Transition of - {is_specification : bool, + {isSpecification : bool, xmiid : string, source : StateVertex_Id, target : StateVertex_Id, guard : Guard option, trigger : Event option, - effect : Action option + effect : Procedure option (* mmm : StateVertexId option *) } @@ -77,85 +85,85 @@ datatype PseudoStateVars = initial | deep | shallow | junction | choice datatype StateVertex = - State_CompositState + CompositeState of {xmiid : string, name : string, - is_specification : bool, + isSpecification : bool, isConcurrent : bool, - entry : Action option, - exit : Action option, - doActivity : Action option, + entry : Procedure option, + exit : Procedure option, + doActivity : Procedure option, outgoing : Transition_Id list, incoming : Transition_Id list, subvertex : StateVertex list} - | CompositState_SubactivityState + | SubactivityState of {xmiid : string, name : string, - is_specification : bool, + isSpecification : bool, isConcurrent : bool, - entry : Action option, - exit : Action option, - doActivity : Action option, + entry : Procedure option, + exit : Procedure option, + doActivity : Procedure option, outgoing : Transition_Id list, incoming : Transition_Id list, subvertex : StateVertex list, submachine : StateMachine, isDynamic : bool} - | State_SimpleState + | SimpleState of {xmiid : string, name : string, - is_specification : bool, - entry : Action option, - exit : Action option, - doActivity : Action option, + isSpecification : bool, + entry : Procedure option, + exit : Procedure option, + doActivity : Procedure option, outgoing : Transition_Id list, incoming : Transition_Id list} - | SimpleState_ActionState (* from ActivityGraphs *) + | ActionState (* from ActivityGraphs *) of {xmiid : string, name : string, - is_specification : bool, - entry : Action option, - exit : Action option, - doActivity : Action option, + isSpecification : bool, + entry : Procedure option, + exit : Procedure option, + doActivity : Procedure option, outgoing : Transition_Id list, incoming : Transition_Id list, isDynamic : bool (* + dynamicArguments + dynamicMultiplicity *)} - | SimpleState_ObjectflowState (* from ActivityGraphs *) + | ObjectFlowState (* from ActivityGraphs *) of {xmiid : string, name : string, - is_specification : bool, - entry : Action option, - exit : Action option, - doActivity : Action option, + isSpecification : bool, + entry : Procedure option, + exit : Procedure option, + doActivity : Procedure option, outgoing : Transition_Id list, incoming : Transition_Id list, isSynch : bool, parameter : Parameter list, type_ : Rep_OclType.Path option} - | State_FinalState + | FinalState of {xmiid : string, name : string, - is_specification : bool, - entry : Action option, - exit : Action option, - doActivity : Action option, + isSpecification : bool, + entry : Procedure option, + exit : Procedure option, + doActivity : Procedure option, outgoing : Transition_Id list, incoming : Transition_Id list } | PseudoState of {xmiid : string, name : string, - is_specification : bool, + isSpecification : bool, kind : PseudoStateVars, - entry : Action option, - exit : Action option, - doActivity : Action option, + entry : Procedure option, + exit : Procedure option, + doActivity : Procedure option, outgoing : Transition_Id list, incoming : Transition_Id list } | SyncState of {xmiid : string, name : string, - is_specification : bool, + isSpecification : bool, outgoing : Transition_Id list, incoming : Transition_Id list, bound : int} @@ -164,7 +172,7 @@ datatype StateVertex = and StateMachine = mk_StateMachine of {xmiid : string, contextxmiid : string, - is_specification : bool, + isSpecification : bool, top : StateVertex, transitions : Transition list} diff --git a/src/xml2xmi.sml b/src/xml2xmi.sml index 709eb9b..27fe3a0 100644 --- a/src/xml2xmi.sml +++ b/src/xml2xmi.sml @@ -56,6 +56,8 @@ fun getIntAtt string atts = " with unexpected value "^att) end +val getLang = getStringAtt "language" +val getBody = getStringAtt "body" val getXmiId = getStringAtt "xmi.id" val getName = getStringAtt "name" val getXmiIdref = getStringAtt "xmi.idref" @@ -553,9 +555,46 @@ fun mkGeneralization tree = end +fun mkProcedure tree = + let fun get_AttrL x = (XmlTree.attributes_of o (XmlTree.find "UML:ActionExpression") o + XmlTree.children_of o (XmlTree.find "UML:Action.script")) x + handle _ => (writeln(getXmiId(XmlTree.attributes_of tree)); []) + fun f atts trees = XMI.mk_Procedure{ + xmiid = getXmiId atts, + name = getName atts, + isSpecification = getBoolAtt "isSpecification" atts, + isAsynchronous = getBoolAtt "isAsynchronous" atts, + language = getLang(get_AttrL trees), + body = getBody(get_AttrL trees), + expression = nil} + in XmlTree.apply_on "UML:CallAction" f tree + (* POSEIDON specific ! According to UML 1.5, should be: "UML:Method" *) + end + + +fun mkGuard tree = + let val getExpr = XmlTree.attributes_of o (XmlTree.find "UML:BooleanExpression") o + XmlTree.children_of o (XmlTree.find "UML:Guard.expression") + fun f atts trees = XMI.mk_Guard{ + xmiid = getXmiId atts, + name = getName atts, + isSpecification = getBoolAtt "isSpecification" atts, + visibility = getVisibility atts, + language = getLang(getExpr trees), + body = getBody(getExpr trees), + expression = nil} + in XmlTree.apply_on "UML:Guard" f tree + end + + fun mkTransition tree = - let fun f atts trees = XMI.mk_Transition - {is_specification = getBoolAtt "isSpecification" atts, + let val getGuard = (ap_some (mkGuard o + (XmlTree.find "UML:Guard") o + XmlTree.children_of)) o + (XmlTree.find_some "UML:Transition.guard") + + fun f atts trees = XMI.mk_Transition + {isSpecification = getBoolAtt "isSpecification" atts, xmiid = getXmiId atts, source = (getXmiIdref o XmlTree.attributes_of o hd o XmlTree.children_of o @@ -565,7 +604,7 @@ fun mkTransition tree = hd o XmlTree.children_of o (XmlTree.find "UML:Transition.target")) (trees), - guard = NONE, (* TO BE DONE *) + guard = getGuard trees, trigger= NONE, (* TO BE DONE *) effect = NONE (* TO BE DONE *)} in XmlTree.apply_on "UML:Transition" f tree @@ -584,73 +623,77 @@ fun getPseudoStateKindAttr atts = fun mkState tree = - let val elem = XmlTree.tagname_of tree - val atts = XmlTree.attributes_of tree - val trees = XmlTree.children_of tree - val xmiid = getXmiId atts - val name = getName atts + let val elem = XmlTree.tagname_of tree + val atts = XmlTree.attributes_of tree + val trees = XmlTree.children_of tree + val xmiid = getXmiId atts + val name = getName atts val isSpecification = getBoolAtt "isSpecification" atts - fun getTid x = (getXmiIdref o XmlTree.attributes_of) x - handle _ => "XXX" + val getTid = getXmiIdref o XmlTree.attributes_of fun getTrans str = List.concat o (map ((map getTid) o XmlTree.children_of)) o (XmlTree.filter str) - val getIncoming = getTrans "UML:StateVertex.incoming" - val getOutgoing = getTrans "UML:StateVertex.outgoing" - val getSubvertex= (map mkState) o XmlTree.children_of o - (XmlTree.find "UML:CompositeState.subvertex") + val getIncoming = getTrans "UML:StateVertex.incoming" + val getOutgoing = getTrans "UML:StateVertex.outgoing" + val getSubvertex = (map mkState) o XmlTree.children_of o + (XmlTree.find "UML:CompositeState.subvertex") + val getEntry = (ap_some (mkProcedure o + (XmlTree.find "UML:CallAction") o + XmlTree.children_of)) o + (XmlTree.find_some "UML:State.entry") + (* val visibility = getVisibility atts *) in case elem of "UML:CompositeState" => - XMI.State_CompositState{ - xmiid=xmiid,name=name,is_specification=isSpecification, + XMI.CompositeState{ + xmiid=xmiid,name=name,isSpecification=isSpecification, isConcurrent = getBoolAtt "isConcurrent" atts, outgoing = getOutgoing trees, incoming = getIncoming trees, subvertex = getSubvertex trees, - entry = NONE, + entry = getEntry trees, exit = NONE, doActivity = NONE } |"UML:SubactivityState" => - XMI.CompositState_SubactivityState{ - xmiid=xmiid,name=name,is_specification=isSpecification, + XMI.SubactivityState{ + xmiid=xmiid,name=name,isSpecification=isSpecification, isConcurrent = getBoolAtt "isConcurrent" atts, isDynamic = getBoolAtt "isDynamic" atts, outgoing = getOutgoing trees, incoming = getIncoming trees, subvertex = getSubvertex trees, - entry = NONE, + entry = getEntry trees, exit = NONE, doActivity = NONE, submachine = mkStateMachine (hd trees) (* HACK ! So far, no UML tool supports this. Parser has to be adapted of we find a first example ... *)} |"UML:ActionState" => - XMI.SimpleState_ActionState { - xmiid=xmiid,name=name,is_specification=isSpecification, + XMI.ActionState { + xmiid=xmiid,name=name,isSpecification=isSpecification, outgoing = getOutgoing trees, incoming = getIncoming trees, isDynamic = getBoolAtt "isDynamic" atts, - entry = NONE, + entry = getEntry trees, exit = NONE, doActivity = NONE} |"UML:Pseudostate" => XMI.PseudoState { - xmiid=xmiid,name=name,is_specification=isSpecification, - entry = NONE, + xmiid=xmiid,name=name,isSpecification=isSpecification, + entry = getEntry trees, exit = NONE, doActivity = NONE, kind = getPseudoStateKindAttr atts, outgoing = getOutgoing trees,incoming = getIncoming trees} |"UML:SimpleState" => - XMI.State_SimpleState{ - xmiid=xmiid,name=name,is_specification=isSpecification, - entry = NONE, + XMI.SimpleState{ + xmiid=xmiid,name=name,isSpecification=isSpecification, + entry = getEntry trees, exit = NONE, doActivity = NONE, outgoing = getOutgoing trees, incoming = getIncoming trees} - |"UML:ObjectflowState" => - XMI.SimpleState_ObjectflowState{ - xmiid=xmiid,name=name,is_specification=isSpecification, - entry = NONE, + |"UML:ObjectFlowState" => + XMI.ObjectFlowState{ + xmiid=xmiid,name=name,isSpecification=isSpecification, + entry = getEntry trees, exit = NONE, doActivity = NONE, outgoing = getOutgoing trees, incoming = getIncoming trees, @@ -658,15 +701,15 @@ fun mkState tree = parameter = nil, type_ = NONE} |"UML:FinalState" => - XMI.State_FinalState{ - xmiid=xmiid,name=name,is_specification=isSpecification, - entry = NONE, + XMI.FinalState{ + xmiid=xmiid,name=name,isSpecification=isSpecification, + entry = getEntry trees, exit = NONE, doActivity = NONE, outgoing = getOutgoing trees,incoming = getIncoming trees} |"UML:SyncState" => XMI.SyncState{ - xmiid=xmiid,name=name,is_specification=isSpecification, + xmiid=xmiid,name=name,isSpecification=isSpecification, bound = 0, outgoing = getOutgoing trees,incoming = getIncoming trees} @@ -674,9 +717,10 @@ fun mkState tree = end + and mkStateMachine tree = let fun f atts trees = XMI.mk_StateMachine - {is_specification = getBoolAtt "isSpecification" atts, + {isSpecification = getBoolAtt "isSpecification" atts, xmiid = getXmiId atts, contextxmiid = (getXmiIdref o XmlTree.attributes_of o hd o XmlTree.children_of o @@ -692,10 +736,9 @@ and mkStateMachine tree = end; - fun mkActivityGraph tree = let fun f atts trees = XMI.mk_ActivityGraph - {is_specification = getBoolAtt "isSpecification" atts, + {isSpecification = getBoolAtt "isSpecification" atts, xmiid = getXmiId atts, contextxmiid = (getXmiIdref o XmlTree.attributes_of o hd o XmlTree.children_of o diff --git a/src/xmltree_parser.sml b/src/xmltree_parser.sml index d4ffb5b..2db8b13 100644 --- a/src/xmltree_parser.sml +++ b/src/xmltree_parser.sml @@ -38,6 +38,7 @@ sig val skip : string -> Tree -> Tree list val filter : string -> Tree list -> Tree list val filter_children : string -> Tree -> Tree list + val find_some : string -> Tree list -> Tree option val find : string -> Tree list -> Tree val find_child : string -> Tree -> Tree val dfs : string -> Tree -> Tree option @@ -76,6 +77,7 @@ fun filter string trees = List.filter (fn x => string = tagname_of x) fun filter_children string tree = List.filter (fn x => string = tagname_of x) (children_of tree) +fun find_some string trees = (List.find (fn x => string = tagname_of x) trees) fun find string trees = valOf (List.find (fn x => string = tagname_of x) trees) handle Option => raise IllFormed ("in XmlTree.find: did not find element "^string)