Guards und Entries eingebaut.
git-svn-id: https://projects.brucker.ch/su4sml/svn/infsec-import/trunk/src/su4sml@3048 3260e6d1-4efc-4170-b0a7-36055960796d
This commit is contained in:
parent
93620333cf
commit
a5671a5d4f
|
|
@ -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";
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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}
|
||||
|
|
|
|||
|
|
@ -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}
|
||||
|
||||
|
|
|
|||
121
src/xml2xmi.sml
121
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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
Loading…
Reference in New Issue