some cleanup, mostly state machines
git-svn-id: https://projects.brucker.ch/su4sml/svn/infsec-import/trunk/src/su4sml@6086 3260e6d1-4efc-4170-b0a7-36055960796d
This commit is contained in:
Jürgen Doser
parent
743110b62f
commit
08d3897b87
|
|
@ -12,6 +12,7 @@ struct
|
|||
open Rep
|
||||
open Rep_OclType
|
||||
open Rep_OclTerm
|
||||
|
||||
(* open Rep_SecureUML_ComponentUML.Security*)
|
||||
open ComponentUML
|
||||
open XMI_DataTypes
|
||||
|
|
@ -19,23 +20,23 @@ open XMI_DataTypes
|
|||
|
||||
val emptyEvent = CallEvent(["","","EMPTY"],[])
|
||||
val emptyGuard = OperationCall(Variable("",DummyT),DummyT,["EMPTY"],[],DummyT):Guard
|
||||
val emptyState = (State_SimpleState({ state_id="",
|
||||
val emptyState = (Rep_StateMachine.State_SimpleState({ state_id="",
|
||||
outgoing=[],
|
||||
incoming=[],
|
||||
name=""}))
|
||||
|
||||
val emptyTransition = (T_mk({effect=NONE,
|
||||
guard=NONE,
|
||||
source="",
|
||||
target="",
|
||||
trans_id="",
|
||||
trigger=NONE}))
|
||||
|
||||
val emptyTransition = {effect=NONE,
|
||||
guard=NONE,
|
||||
source="",
|
||||
target="",
|
||||
trans_id="",
|
||||
trigger=NONE}
|
||||
|
||||
val lastGuard = OperationCall(Variable("self",DummyT),DummyT,["else"],[],Boolean):Guard
|
||||
val alwaysTrigger = CallEvent(["auto","auto","auto"],[])
|
||||
val alwaysGuard = OperationCall(Variable("self",DummyT), DummyT, ["alwaysG"],[],Boolean):Guard
|
||||
val emptyEffect = Proc_mk{proc_id="",
|
||||
language="",
|
||||
body="",
|
||||
expression=""}
|
||||
val emptyEffect = {proc_id="",
|
||||
language="",
|
||||
body="",
|
||||
expression=""}
|
||||
end
|
||||
|
|
|
|||
|
|
@ -74,9 +74,9 @@ fun super2Native "ClassifierScope" = "static"
|
|||
* overrides some lookup entries of the base cartridge
|
||||
*)
|
||||
fun lookup (env : environment) "attribute_name_small_letter"
|
||||
= StringHandling.startWithSmallLetter (SuperCart.lookup (unpack env) "attribute_name")
|
||||
= StringHandling.uncapitalize (SuperCart.lookup (unpack env) "attribute_name")
|
||||
| lookup (env : environment) "attribute_name_capital"
|
||||
= StringHandling.startWithCapital (SuperCart.lookup (unpack env) "attribute_name")
|
||||
= StringHandling.capitalize (SuperCart.lookup (unpack env) "attribute_name")
|
||||
| lookup (env : environment) (s as "attribute_type") = super2Native (SuperCart.lookup (unpack env) s )
|
||||
| lookup (env : environment) (s as "attribute_visibility")= super2Native (SuperCart.lookup (unpack env) s)
|
||||
| lookup (env : environment) (s as "attribute_scope") = super2Native (SuperCart.lookup (unpack env) s)
|
||||
|
|
|
|||
|
|
@ -97,7 +97,7 @@ fun lookup (env : environment) "state_name" = toUpper(name_of_state(#curState en
|
|||
| lookup (env : environment) "guard_ident" = ident_of_guard(#1(#curGuard env))
|
||||
| lookup (env : environment) "event_name" = toUpper(name_of_event(#curEvent env))
|
||||
| lookup (env : environment) "cur_event_id" = toUpper(name_of_event(#curEvent env))
|
||||
| lookup (env : environment) "effect_ident" = ident_of_effect(#curEffect env)
|
||||
| lookup (env : environment) "effect_ident" = #proc_id (#curEffect env)
|
||||
| lookup (env : environment) "trigger_name" = name_of_event(#curEvent env)
|
||||
| lookup (env : environment) "real_init" = id_of_state(realInit(Option.valOf(SuperCart.curClassifier (unpack env))))
|
||||
| lookup (env : environment) s = SuperCart.lookup (unpack env) s
|
||||
|
|
@ -107,7 +107,7 @@ fun evalCondition (env : environment) "hasAG" = hasAG(Option.valOf(SuperCart.cur
|
|||
| evalCondition (env : environment) "isTrigger" = let val Transitions = transitions_of_classif(Option.valOf(SuperCart.curClassifier (unpack env)))
|
||||
val oper = Option.valOf(SuperCart.curOperation (unpack env))
|
||||
in
|
||||
acts_as_trigger(oper,Transitions)
|
||||
acts_as_trigger oper Transitions
|
||||
end
|
||||
| evalCondition (env : environment) "isLastGuard" = (#2(#curGuard env)) = 0
|
||||
| evalCondition (env : environment) "isLastTrans" = (#2(#curTransition env)) = 0
|
||||
|
|
@ -215,7 +215,7 @@ fun foreach_guard(env: environment) = let val GL = guards_of_SM_Trans(#1(#curTra
|
|||
List.map env_from_GL (transform(GL,(LEN-1)))
|
||||
end
|
||||
|
||||
fun all_guards(env: environment) = let val AGL = createDistinct(List.concat (List.map guards_of_SM_Trans (#allTransitions env)))
|
||||
fun all_guards(env: environment) = let val AGL = makeDistinct(List.concat (List.map guards_of_SM_Trans (#allTransitions env)))
|
||||
fun env_from_GL G = {
|
||||
curState = #curState env,
|
||||
allTransitions = #allTransitions env,
|
||||
|
|
|
|||
|
|
@ -71,9 +71,9 @@ fun super2Native "ClassifierScope" = "static"
|
|||
* overrides some lookup entries of the base cartridge
|
||||
*)
|
||||
fun lookup (env : environment) "attribute_name_small_letter"
|
||||
= StringHandling.startWithSmallLetter (SuperCart.lookup (unpack env) "attribute_name")
|
||||
= StringHandling.uncapitalize (SuperCart.lookup (unpack env) "attribute_name")
|
||||
| lookup (env : environment) "attribute_name_capital"
|
||||
= StringHandling.startWithCapital (SuperCart.lookup (unpack env) "attribute_name")
|
||||
= StringHandling.capitalize (SuperCart.lookup (unpack env) "attribute_name")
|
||||
| lookup (env : environment) (s as "attribute_type") = super2Native (SuperCart.lookup (unpack env) s )
|
||||
| lookup (env : environment) (s as "attribute_visibility")= super2Native (SuperCart.lookup (unpack env) s)
|
||||
| lookup (env : environment) (s as "attribute_scope") = super2Native (SuperCart.lookup (unpack env) s)
|
||||
|
|
|
|||
|
|
@ -24,13 +24,6 @@
|
|||
(* 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
|
||||
(*****************************************************************************************)
|
||||
|
||||
(*use "../../me/sources/types.sml";
|
||||
use "../../me/sources/helperFunctions.sml";
|
||||
use "../../me/sources/stringHandling.sml";
|
||||
|
||||
|
||||
use "SM_helper.sml";
|
||||
*)
|
||||
|
||||
structure StateMachine =
|
||||
struct
|
||||
|
|
@ -41,16 +34,12 @@ open Rep_OclTerm
|
|||
open Rep_StateMachine
|
||||
open SM_Helper
|
||||
open StateMachineTypes
|
||||
|
||||
open ListEq
|
||||
(********************************************)
|
||||
(* Generic types handling functions: *)
|
||||
(* --------------------------------- *)
|
||||
(********************************************)
|
||||
|
||||
(*simulate SET behaviour*)
|
||||
(* ''a list -> ''a list *)
|
||||
fun createDistinct([]) = []
|
||||
| createDistinct(h::t) = createDistinct((List.filter (fn x => not (x=h)) t))@[h]
|
||||
|
||||
(*return the initial state*)
|
||||
exception MalformedStateMachine
|
||||
|
|
@ -61,117 +50,22 @@ exception MalformedStateMachine
|
|||
(* ------------------------- *)
|
||||
(************************************)
|
||||
|
||||
fun is_StartState(PseudoState{kind,...}) = (kind=XMI.initial)
|
||||
| is_StartState(_) = false
|
||||
|
||||
(* StateVertex -> StateVertex_Id *)
|
||||
fun id_of_state(State_SimpleState{state_id,...}) = state_id
|
||||
| id_of_state(State_CompositeState{state_id,...}) = state_id
|
||||
| id_of_state(SimpleState_ActionState{state_id,...}) = state_id
|
||||
| id_of_state(SimpleState_ObjectflowState{state_id,...}) = state_id
|
||||
| id_of_state(State_FinalState{state_id,...}) = state_id
|
||||
| id_of_state(PseudoState{state_id,...}) = state_id
|
||||
| id_of_state(SyncState{state_id,...}) = state_id
|
||||
|
||||
fun name_of_state(State_SimpleState{name,...}) = name
|
||||
| name_of_state(State_CompositeState{name,...}) = name
|
||||
| name_of_state(SimpleState_ActionState{name,...}) = name
|
||||
| name_of_state(State_FinalState{...}) = "Final"
|
||||
| name_of_state(S as PseudoState{kind,...}) = case kind
|
||||
of XMI.initial => "INIT"^id_of_state(S)
|
||||
| XMI.junction => "ERROR"
|
||||
| _ => "WRONG"
|
||||
|
||||
(* StateVertex_Id * StateVertex list ref -> StateVertex *)
|
||||
fun get_state_by_id(id:StateVertex_Id, SLp: StateVertex list ref) = let fun hasID i S = (id_of_state(S) = i)
|
||||
val filterf = hasID id
|
||||
in
|
||||
hd (List.filter filterf (!SLp))
|
||||
end
|
||||
|
||||
(*returns the list of subvertices *)
|
||||
(* StateVertex -> StateVertex list *)
|
||||
fun get_subvertex_list(State_CompositeState{subvertex,...}) = subvertex
|
||||
| get_subvertex_list(S:StateVertex) = []
|
||||
|
||||
(*return list of outgoing states' transition ids*)
|
||||
(* StateVertex -> Transition_Id list *)
|
||||
fun get_next_transitions_ID(State_SimpleState{outgoing,...}) = outgoing
|
||||
| get_next_transitions_ID(State_CompositeState{outgoing,...}) = outgoing
|
||||
| get_next_transitions_ID(SimpleState_ActionState{outgoing,...}) = outgoing
|
||||
| get_next_transitions_ID(SimpleState_ObjectflowState{outgoing,...}) = outgoing
|
||||
| get_next_transitions_ID(State_FinalState{...}) = []
|
||||
| get_next_transitions_ID(PseudoState{outgoing,...}) = outgoing
|
||||
| get_next_transitions_ID(SyncState{outgoing,...}) = outgoing
|
||||
|
||||
(* StateVertex -> Transition_Id list *)
|
||||
fun get_prev_transitions_T(State_SimpleState{incoming,...}) = incoming
|
||||
| get_prev_transitions_T(State_CompositeState{incoming,...}) = incoming
|
||||
| get_prev_transitions_T(SimpleState_ActionState{incoming,...}) = incoming
|
||||
| get_prev_transitions_T(SimpleState_ObjectflowState{incoming,...}) = incoming
|
||||
| get_prev_transitions_T(State_FinalState{...}) = []
|
||||
| get_prev_transitions_T(PseudoState{incoming,...}) = incoming
|
||||
| get_prev_transitions_T(SyncState{incoming,...}) = incoming
|
||||
|
||||
(* StateVertex -> bool *)
|
||||
fun isPseudo(PseudoState{kind,...}) = not(kind=XMI.initial)
|
||||
| isPseudo(_) = false
|
||||
|
||||
fun isInit(PseudoState{kind,...}) = kind=XMI.initial
|
||||
| isInit(_) = false
|
||||
|
||||
(* StateVertex -> bool *)
|
||||
(* fun Final(State_FinalState x) = true *)
|
||||
(* | Final(_) = false *)
|
||||
fun isFinal(State_FinalState{...}) = true
|
||||
| isFinal(_) = false
|
||||
|
||||
|
||||
fun FinalState(SL:StateVertex list) = hd (List.filter (fn (State_FinalState x) => true
|
||||
| (_) => false) SL)
|
||||
|
||||
(* get list of subvertices *)
|
||||
(* StateVertex -> StateVertex list *)
|
||||
fun subvertices_of_state(State_CompositeState{subvertex,...}) = subvertex
|
||||
| subvertices_of_state(S:StateVertex) = []
|
||||
fun get_state_by_id (id:StateVertex_Id, SLp: StateVertex list ref) =
|
||||
hd (List.filter (fn x => id_of_state x = id) (!SLp))
|
||||
|
||||
fun FinalState (SL:StateVertex list) = hd (List.filter isFinal SL)
|
||||
|
||||
|
||||
(* StateVertex * SM_Trans list ref -> SM_Trans list *)
|
||||
fun get_next_SM_Trans(S, TLp) = let fun filterF({source,...}:SM_Trans) = (source = id_of_state(S))
|
||||
in
|
||||
List.filter filterF (!TLp)
|
||||
end
|
||||
fun get_next_SM_Trans (s:StateVertex) TLp =
|
||||
List.filter (fn (x:SM_Trans) => #source x = id_of_state s) (!TLp)
|
||||
|
||||
(* StateVertex * SM_Trans list ref * 'a -> Event list *)
|
||||
fun events_of_state(S:StateVertex, TLp, SLp) = let val TransitionOutList = get_next_SM_Trans(S,TLp)
|
||||
fun TRIGGERS({triggers,...}:SM_Trans) = triggers
|
||||
fun collectEvts([]) = []
|
||||
| collectEvts(h::t) = TRIGGERS(h)::collectEvts(t)
|
||||
in
|
||||
createDistinct(List.concat (collectEvts(TransitionOutList)))
|
||||
end
|
||||
|
||||
(*****************************************)
|
||||
(* Transition handling functions: *)
|
||||
(* ------------------------------ *)
|
||||
(*****************************************)
|
||||
|
||||
(* Transition -> Transition_Id *)
|
||||
fun id_of_trans(T_mk{trans_id,...}) = trans_id
|
||||
|
||||
(* Transition -> StateVertex_Id *)
|
||||
fun source_of_trans(T_mk{source,...}) = source
|
||||
|
||||
(* Transition -> StateVertex_Id *)
|
||||
fun target_of_trans(T_mk{target,...}) = target
|
||||
|
||||
(* Transition -> Guard option *)
|
||||
fun guard_of_trans(T_mk{guard,...}) = guard
|
||||
|
||||
fun effect_of_trans(T_mk{effect,...}) = effect
|
||||
|
||||
(* Transition -> Event option *)
|
||||
fun trigger_of_trans(T_mk{trigger,...}) = trigger
|
||||
|
||||
fun events_of_state (S:StateVertex, TLp, SLp) =
|
||||
(makeDistinct o List.concat o map #triggers o get_next_SM_Trans S) TLp
|
||||
|
||||
|
||||
(***************************************)
|
||||
(* SM_Trans handling functions: *)
|
||||
|
|
@ -179,23 +73,23 @@ fun trigger_of_trans(T_mk{trigger,...}) = trigger
|
|||
(***************************************)
|
||||
|
||||
(* SM_Trans -> StateVertex_Id *)
|
||||
fun target_of_SM_Trans({target,...}:SM_Trans) = target
|
||||
fun target_of_SM_Trans ({target,...}:SM_Trans) = target
|
||||
|
||||
(* SM_Trans -> Guard list *)
|
||||
fun guards_of_SM_Trans({guards,...}:SM_Trans) = guards
|
||||
fun guards_of_SM_Trans ({guards,...}:SM_Trans) = guards
|
||||
|
||||
(* SM_Trans -> Event list *)
|
||||
fun triggers_of_SM_Trans({triggers,...}:SM_Trans) = triggers
|
||||
fun triggers_of_SM_Trans ({triggers,...}:SM_Trans) = triggers
|
||||
|
||||
(* Transition_Id * StateVertex_Id * StateVertex_Id * Guard list * Event list * Action list -> SM_Trans *)
|
||||
fun mk_SM_T(tid, s, t, ga, ta, ea) = {trans_id = tid,
|
||||
source = s,
|
||||
target = t,
|
||||
guards = ga,
|
||||
triggers = ta,
|
||||
effects = ea}:SM_Trans
|
||||
|
||||
|
||||
fun mk_SM_T (tid, s, t, ga, ta, ea) = {trans_id = tid,
|
||||
source = s,
|
||||
target = t,
|
||||
guards = ga,
|
||||
triggers = ta,
|
||||
effects = ea}:SM_Trans
|
||||
|
||||
|
||||
(************************************)
|
||||
(* Event handling functions: *)
|
||||
(* ------------------------- *)
|
||||
|
|
@ -217,273 +111,190 @@ fun path_of_event(CallEvent([a,b,c],_)) = c
|
|||
(* ------------------------------ *)
|
||||
(*****************************************)
|
||||
|
||||
(*returns the activity graphs (list) of the given Classifier --> this is a list of StateMachines*)
|
||||
(* Classifier -> ActivityGraph list *)
|
||||
fun ActGraph_of_classif(Class{activity_graphs,...}) = activity_graphs
|
||||
| ActGraph_of_classif(_) = []
|
||||
|
||||
(*get the list of transitions *)
|
||||
(* ActivityGraph -> Transition list *)
|
||||
fun transitions_of_SM(SM_mk{transition,...}:ActivityGraph) = transition
|
||||
|
||||
(*return top state of a state machine*)
|
||||
(* StateMachine -> StateVertex *)
|
||||
fun top_state_of(SM_mk{top,...}) = top
|
||||
|
||||
(*get all defined activity graphs in a list of Classifiers --> ActivityGraph list*)
|
||||
(* Classifier list -> ActivityGraph list *)
|
||||
fun ActGraph_of_classif_from_list(C:Classifier list) = let fun isFull l = (fn x => (List.length x > 0)) l
|
||||
in
|
||||
List.concat (List.filter isFull (List.map ActGraph_of_classif C))
|
||||
end
|
||||
fun ActGraph_of_classif_from_list (C:Classifier list) =
|
||||
List.concat (map activity_graphs_of C)
|
||||
|
||||
|
||||
fun name_of_classif(C as Class c) = Rep.short_name_of C
|
||||
| name_of_classif(Primitive p) = "PRIMITIVE"
|
||||
| name_of_classif(_) = "XXX"
|
||||
fun name_of_classif (C as Class c) = Rep.short_name_of C
|
||||
| name_of_classif (Primitive p) = "PRIMITIVE"
|
||||
| name_of_classif (_) = "XXX"
|
||||
|
||||
(*return list of subertices ot the given Classifier (Class, Primitive,...)*)
|
||||
(* Classifier -> StateVertex list *)
|
||||
fun states_of_classif(C:Classifier) = let fun soc(x) = let val SM:StateMachine list = ActGraph_of_classif(x)
|
||||
in
|
||||
if SM=[] then []
|
||||
(*FIXME: SM can have more than one AG defined... (remove "hd")
|
||||
SM can be another type than CompositeState...*)
|
||||
else get_subvertex_list(top_state_of(hd SM))
|
||||
end
|
||||
val SL1 = soc(C)
|
||||
fun dive([]) = []
|
||||
| dive((State_CompositeState{name=n,
|
||||
subvertex=a,
|
||||
incoming=b,
|
||||
isConcurrent=c,
|
||||
outgoing=d,
|
||||
state_id=f})::t) = a@[(State_CompositeState{name=n,
|
||||
subvertex=a,
|
||||
incoming=b,
|
||||
isConcurrent=c,
|
||||
outgoing=d,
|
||||
state_id=f})]@dive(t)
|
||||
| dive(h::t) = h::dive(t)
|
||||
in
|
||||
dive(SL1)
|
||||
end
|
||||
fun states_of_classif (C:Classifier) =
|
||||
let fun soc x =
|
||||
let val SM:StateMachine list = activity_graphs_of x
|
||||
in
|
||||
if SM=[] then []
|
||||
(*FIXME: SM can have more than one AG defined... (remove "hd")
|
||||
SM can be another type than CompositeState...*)
|
||||
else subvertices_of (#top (hd SM))
|
||||
end
|
||||
fun dive [] = []
|
||||
| dive ((State_CompositeState{name=n,
|
||||
subvertex=a,
|
||||
incoming=b,
|
||||
isConcurrent=c,
|
||||
outgoing=d,
|
||||
state_id=f})::t) =
|
||||
(* FIXME: don't we have to recurse here into a? *)
|
||||
a@[(State_CompositeState{name=n,
|
||||
subvertex=a,
|
||||
incoming=b,
|
||||
isConcurrent=c,
|
||||
outgoing=d,
|
||||
state_id=f})]@dive(t)
|
||||
| dive (h::t) = h::dive(t)
|
||||
in
|
||||
dive (soc C)
|
||||
end
|
||||
|
||||
|
||||
|
||||
(* Classifier -> Transition list *)
|
||||
fun transitions_of_classif(C:Classifier) = let val AG:ActivityGraph list = ActGraph_of_classif(C)
|
||||
in
|
||||
if AG = [] then []
|
||||
else transitions_of_SM(hd AG)
|
||||
end
|
||||
|
||||
fun events_of_classif(C:Classifier) = let val TL = transitions_of_classif(C)
|
||||
val TrigL = List.map trigger_of_trans TL
|
||||
in
|
||||
createDistinct (List.map Option.valOf (List.filter Option.isSome TrigL))
|
||||
end
|
||||
|
||||
|
||||
|
||||
|
||||
fun transitions_of_classif (C:Classifier) =
|
||||
let val AG:ActivityGraph list = activity_graphs_of C
|
||||
in
|
||||
if AG = [] then []
|
||||
else #transition (hd AG)
|
||||
end
|
||||
|
||||
fun events_of_classif (C:Classifier) =
|
||||
makeDistinct (List.mapPartial #trigger (transitions_of_classif C))
|
||||
|
||||
(*returns a string with every transition_id separated by a "," *)
|
||||
(* Classifier -> string *)
|
||||
fun get_names_of_trans(C:Classifier) = let val SM = ActGraph_of_classif C
|
||||
val transitions_LL = List.map transitions_of_SM SM
|
||||
fun concat_names s [] = s
|
||||
| concat_names s (h::t) = concat_names (s^","^h) t
|
||||
val ids = List.map id_of_trans (List.concat transitions_LL)
|
||||
in
|
||||
concat_names "" ids
|
||||
end
|
||||
|
||||
fun get_names_of_trans (C:Classifier) =
|
||||
let val ids = map #trans_id (List.concat (map #transition (activity_graphs_of C)))
|
||||
in
|
||||
String.concatWith "," ids
|
||||
end
|
||||
|
||||
|
||||
|
||||
|
||||
(*processes the list of given {Simple,Pseudo,...} states and creates a "sane" representation. *)
|
||||
(* Transition_Id * Transition list ref -> Transition *)
|
||||
fun get_trans_by_id(id:Transition_Id, TLp: Transition list ref) = let fun hasID i T = (id_of_trans(T) = i)
|
||||
val filterf = hasID id
|
||||
val TL = !TLp
|
||||
in
|
||||
hd (List.filter filterf TL)
|
||||
end
|
||||
|
||||
fun get_trans_by_id (id:Transition_Id, TLp: Transition list ref) =
|
||||
hd (List.filter (fn x => #trans_id x = id) (!TLp))
|
||||
|
||||
|
||||
(*returns list of state having given kind. NOTE: this only applies for PseudoStates*)
|
||||
(* PseudoStateVars * StateVertex list -> StateVertex list *)
|
||||
fun get_state_by_kind(KIND:PseudoStateVars, SVL: StateVertex list) = let fun hasKind k (PseudoState{kind,...}) = (k = kind)
|
||||
| hasKind k _ = false
|
||||
val filterF = hasKind KIND
|
||||
in
|
||||
List.filter filterF SVL
|
||||
end
|
||||
|
||||
fun get_state_by_kind (KIND:PseudoStateVars, SVL: StateVertex list) =
|
||||
let fun hasKind k (PseudoState{kind,...}) = (k = kind)
|
||||
| hasKind k _ = false
|
||||
in
|
||||
List.filter (hasKind KIND) SVL
|
||||
end
|
||||
|
||||
(* StateVertex list -> StateVertex *)
|
||||
fun get_initial(SVL: StateVertex list) = let val IL = get_state_by_kind(XMI.initial,SVL)
|
||||
val count = List.length IL
|
||||
in
|
||||
if (count > 1) orelse (count = 0) then raise MalformedStateMachine
|
||||
else hd IL
|
||||
end
|
||||
fun get_initial (SVL: StateVertex list) = case List.find isInit SVL
|
||||
of SOME x => x
|
||||
| _ => raise MalformedStateMachine
|
||||
|
||||
(* StateVertex list -> StateVertex list *)
|
||||
fun get_PseudoStates(C:StateVertex list) = List.filter isPseudo C
|
||||
fun get_PseudoStates (C:StateVertex list) = List.filter isPseudo C
|
||||
|
||||
(* StateVertex list -> StateVertex list *)
|
||||
fun get_other_States(C:StateVertex list) = List.filter (fn x => (not (isPseudo x))) C
|
||||
fun get_other_States (C:StateVertex list) = List.filter (fn x => (not (isPseudo x))) C
|
||||
|
||||
|
||||
|
||||
|
||||
(* returns the list of state ids that are targets of the items in the transition list "outgoing" *)
|
||||
(* StateVertex * Transition list ref -> Transition list *)
|
||||
fun get_next_transitions(S:StateVertex, TransL: Transition list ref) = let fun filterf x y = get_trans_by_id(x, ref y)
|
||||
val OUT_T = get_next_transitions_ID(S)
|
||||
val funList = List.map filterf OUT_T
|
||||
fun foreach([],R,T) = R
|
||||
| foreach(h::t,R,T) = foreach(t,(h T)::R, T)
|
||||
in
|
||||
foreach(funList,[],!TransL)
|
||||
end
|
||||
(* FIXME: there must be some simpler way... *)
|
||||
fun get_next_transitions (s:StateVertex, TransL: Transition list ref) =
|
||||
let fun filterf x y = get_trans_by_id (x, ref y)
|
||||
val funList = List.map filterf (outgoing_of s)
|
||||
in
|
||||
foldl (fn (f,x) => f (!TransL) :: x ) [] funList
|
||||
end
|
||||
|
||||
(* Transition_Id * Transition list -> StateVertex_Id *)
|
||||
fun next_state_id(TransID: Transition_Id, TransList: Transition list) = let val TRANS = get_trans_by_id(TransID, ref TransList)
|
||||
in
|
||||
target_of_trans(TRANS)
|
||||
end
|
||||
|
||||
(* Transition * Transition list * StateVertex list -> GEPath *)
|
||||
(* fun GE(T, TL, SL) = let val S = get_state_by_id(target_of_trans(T),ref SL) *)
|
||||
(* val TRIGGER = trigger_of_trans(T) *)
|
||||
(* val GUARD = guard_of_trans(T) *)
|
||||
(* val NEXTL = get_next_transitions(S,ref TL) *)
|
||||
(* in *)
|
||||
(* if Pseudo(S) then GEBranch(GUARD,TRIGGER,List.map (fn X => GE(X,TL,SL)) NEXTL) *)
|
||||
(* else GELeaf(GUARD,TRIGGER,target_of_trans(T)) *)
|
||||
(* end *)
|
||||
|
||||
(* fun traverseGE(GELeaf(one,two,three)) = [([one],[two],three)] *)
|
||||
(* | traverseGE(GEBranch(one,two,LIST)) = let val DEEPER = List.map traverseGE LIST *)
|
||||
(* val PRUNED = List.concat DEEPER *)
|
||||
(* fun ADD(L1,L2,S) = (one::L1,two::L2,S) *)
|
||||
(* val REALLY = List.map ADD PRUNED *)
|
||||
(* in *)
|
||||
(* REALLY *)
|
||||
(* end *)
|
||||
|
||||
(*or, without the GEPath datastructure: *)
|
||||
fun next_state_id (TransID: Transition_Id, TransList: Transition list) =
|
||||
#target (get_trans_by_id (TransID, ref TransList))
|
||||
|
||||
|
||||
(* operation * Transition list -> bool *)
|
||||
fun acts_as_trigger(O:operation,T: Transition list) = let fun collect_triggers(TL) = let val triggerList = List.map (fn T_mk{trigger,...} => trigger) TL
|
||||
val triggerList_pure = List.filter Option.isSome triggerList
|
||||
val EventList = List.map Option.valOf triggerList_pure
|
||||
fun getPath(CallEvent(path,parameters)) = path
|
||||
| getPath(_) = []: Path
|
||||
fun extractPath(E:Event) = List.nth(getPath(E),2)
|
||||
in
|
||||
List.map extractPath EventList
|
||||
end
|
||||
val TriggerID_list = collect_triggers(T)
|
||||
in
|
||||
List.exists (fn x => x = name_of_op(O)) TriggerID_list
|
||||
end
|
||||
fun acts_as_trigger (O:operation) (T:Transition list) =
|
||||
let val EventList = List.mapPartial #trigger T
|
||||
fun getPath (CallEvent(path,parameters)) = path
|
||||
| getPath (_) = []: Path
|
||||
fun extractPath (E:Event) = List.nth (getPath E, 2)
|
||||
in
|
||||
List.exists (fn x => x = name_of_op O) (map extractPath EventList)
|
||||
end
|
||||
|
||||
|
||||
|
||||
(* operation list * Transition list -> operation list *)
|
||||
fun get_triggers(O: operation list, T: Transition list) = let fun filterf([],Ls,Lr) = Lr
|
||||
| filterf(h::t, Ls, Lr) = if acts_as_trigger(h,Ls) then filterf(t,Ls,h::Lr)
|
||||
else filterf(t,Ls,Lr)
|
||||
in
|
||||
filterf(O,T,[])
|
||||
end
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
(* Classifier -> string list *)
|
||||
fun get_event_list(C:Classifier) = let val EL = events_of_classif(C)
|
||||
in
|
||||
List.map name_of_event EL
|
||||
end
|
||||
|
||||
|
||||
(* returns the path (string list) of the operation call *)
|
||||
(* OclTerm -> Path *)
|
||||
fun path_of_operation(OperationCall(_,_,P,L,_)) = P
|
||||
| path_of_operation(_) = []
|
||||
fun path_of_operation (OperationCall(_,_,P,L,_)) = P
|
||||
| path_of_operation (_) = []
|
||||
|
||||
(* Guard -> Path *)
|
||||
fun path_of_guard(G:Guard) = path_of_operation(G)
|
||||
fun path_of_guard (G:Guard) = path_of_operation(G)
|
||||
|
||||
|
||||
(* Guard -> string *)
|
||||
fun ident_of_guard(G:Guard) = let val sop = string_of_path(path_of_operation(G))
|
||||
in
|
||||
case sop
|
||||
of "else" => "elseG"
|
||||
| _ => sop
|
||||
end
|
||||
|
||||
fun ident_of_guard (G:Guard) = let val sop = string_of_path(path_of_operation(G))
|
||||
in
|
||||
case sop
|
||||
of "else" => "elseG"
|
||||
| _ => sop
|
||||
end
|
||||
(*
|
||||
(* (Guard option list * Event option list * 'a) list -> (string list * string list * 'a) list *)
|
||||
fun processPL(L) = let fun processOptionL(LIST) = List.map (fn X => Option.valOf(X)) (List.filter Option.isSome LIST)
|
||||
fun processOCList(LIST) = List.concat (List.map path_of_guard LIST)
|
||||
fun processEVList(LIST) = List.map name_of_event LIST
|
||||
fun transform(a,b,c) = (processOCList(processOptionL(a)),processEVList(processOptionL(b)),c)
|
||||
in
|
||||
List.map transform L
|
||||
end
|
||||
|
||||
fun processPL L =
|
||||
let fun processOptionL (LIST) = List.mapPartial (fn x => x) LIST
|
||||
fun processOCList (LIST) = List.concat (List.map path_of_guard LIST)
|
||||
fun processEVList (LIST) = List.map name_of_event LIST
|
||||
fun transform (a,b,c) = (processOCList (processOptionL a),
|
||||
processEVList (processOptionL b),
|
||||
c)
|
||||
in
|
||||
List.map transform L
|
||||
end
|
||||
*)
|
||||
(*Classifier -> bool *)
|
||||
fun hasAG(C:Classifier) = let val AG = ActGraph_of_classif(C)
|
||||
in
|
||||
not (AG = [])
|
||||
end
|
||||
fun hasAG (C:Classifier) = not ((activity_graphs_of C) = [])
|
||||
|
||||
(* OclTerm -> bool *)
|
||||
fun is_else_Guard(G as OperationCall(Variable(_,_),_,[a,b,c],_,_)) = a = "else"
|
||||
| is_else_Guard(_) = false
|
||||
fun is_else_Guard (G as OperationCall(Variable(_,_),_,[a,b,c],_,_)) = a = "else"
|
||||
| is_else_Guard (_) = false
|
||||
|
||||
|
||||
(* StateVertex -> bool *)
|
||||
fun isComposite(State_CompositeState{...}) = true
|
||||
| isComposite(_) = false
|
||||
|
||||
(*re-route all transitions pointing to a Composite State.
|
||||
Afther this there does _NOT_ exist a transition from any
|
||||
state to a Composite State anymore *)
|
||||
Afther this there does _NOT_ exist a transition from any
|
||||
state to a Composite State anymore *)
|
||||
(* Transition list * StateVertex list ref -> Transition list *)
|
||||
fun correct_TransList([],_) = []
|
||||
| correct_TransList((head as T_mk{trans_id=tid,
|
||||
source=src,
|
||||
target=tgt,
|
||||
guard=gd,
|
||||
trigger=tr,
|
||||
effect=eff})::tail,StateList) = let val S = get_state_by_id(target_of_trans(head),StateList)
|
||||
in
|
||||
case isComposite(S)
|
||||
of true => let val subvertices = get_subvertex_list(S)
|
||||
(*val outList = get_next_transitions(S,TransList)*)
|
||||
val NextInit = get_initial(subvertices)
|
||||
in
|
||||
T_mk{trans_id=tid,
|
||||
source=src,
|
||||
target=id_of_state(NextInit),
|
||||
guard=gd,
|
||||
trigger=tr,
|
||||
effect=eff}::correct_TransList(tail,StateList)
|
||||
end
|
||||
|
||||
| false => head::correct_TransList(tail,StateList)
|
||||
end
|
||||
|
||||
(* ''a * ''a list -> bool *)
|
||||
fun ListMember(a,L) = List.exists (fn X => X=a) L
|
||||
|
||||
| correct_TransList((head as {trans_id=tid, source=src, target=tgt, guard=gd,
|
||||
trigger=tr, effect=eff})::tail,StateList) =
|
||||
let val S = get_state_by_id(#target(head),StateList)
|
||||
in
|
||||
case isComposite(S)
|
||||
of true => let val subvertices = subvertices_of(S)
|
||||
(*val outList = get_next_transitions(S,TransList)*)
|
||||
val NextInit = get_initial(subvertices)
|
||||
in
|
||||
{trans_id=tid,
|
||||
source=src,
|
||||
target=id_of_state(NextInit),
|
||||
guard=gd,
|
||||
trigger=tr,
|
||||
effect=eff}::correct_TransList(tail,StateList)
|
||||
end
|
||||
|
||||
| false => head::correct_TransList(tail,StateList)
|
||||
end
|
||||
|
||||
|
||||
|
||||
(* ''a * ''a list -> ''a list *)
|
||||
fun removeFromList(a,[]) = []
|
||||
|
|
@ -492,224 +303,221 @@ fun removeFromList(a,[]) = []
|
|||
|
||||
(*assumption: elements are unique --> set-like *)
|
||||
(* ''a list * ''a list -> ''a list *)
|
||||
(* FIXME: find out the intendes semantics and move to ListEq *)
|
||||
fun ListDifference([],L2) = L2
|
||||
| ListDifference(L1,[]) = L1
|
||||
| ListDifference(h::t,L) = if ListMember(h,L) then ListDifference(t,removeFromList(h,L))
|
||||
| ListDifference(h::t,L) = if ListEq.includes L h then ListDifference(t,removeFromList(h,L))
|
||||
else h::ListDifference(t,removeFromList(h,L))
|
||||
(* Transition -> bool *)
|
||||
fun isTriggered(T_mk{trigger=SOME(x),...}) = true
|
||||
| isTriggered(_) = false
|
||||
|
||||
(* return the transitions of this composite state having a trigger defined *)
|
||||
(* StateVertex * Transition list ref -> Transition list *)
|
||||
fun triggered_OUT_Trans(State_CompositeState{outgoing,...}, TL) = let val Trans = List.map (fn X => get_trans_by_id(X,TL)) outgoing
|
||||
in
|
||||
List.filter isTriggered Trans
|
||||
end
|
||||
fun triggered_OUT_Trans(State_CompositeState{outgoing,...}, TL) =
|
||||
let val Trans = List.map (fn X => get_trans_by_id(X,TL)) outgoing
|
||||
in
|
||||
List.filter isTriggered Trans
|
||||
end
|
||||
| triggered_OUT_Trans(_) = []
|
||||
|
||||
(* here we have to handle two cases:
|
||||
1) the super state's (composite state) transitions without a trigger
|
||||
2) the SS' transitions with a trigger
|
||||
In the case of 1) we only have to re-route these transitions such that they have as origin the inner finalState
|
||||
To tackle 2) we have to create for each inner state an additional transition to the the targets of those transitions.
|
||||
Of course the Events/Guards/Effects have to be preserved...
|
||||
*)
|
||||
1) the super state's (composite state) transitions without a trigger
|
||||
2) the SS' transitions with a trigger
|
||||
In the case of 1) we only have to re-route these transitions such that they have as origin the inner finalState
|
||||
To tackle 2) we have to create for each inner state an additional transition to the the targets of those transitions.
|
||||
Of course the Events/Guards/Effects have to be preserved...
|
||||
*)
|
||||
(* StateVertex list * Transition list * Transition list ref -> Transition list *)
|
||||
fun correctCompositeTransitions([],RES,_) = RES
|
||||
| correctCompositeTransitions((SCS as State_CompositeState{name,
|
||||
state_id,
|
||||
outgoing,
|
||||
incoming,
|
||||
subvertex,
|
||||
isConcurrent})::tail,newTrans,allTrans) = let val SV = get_subvertex_list(SCS)
|
||||
val subverticesID = List.map id_of_state SV
|
||||
val subvertex_count = List.length(SV)
|
||||
val triggered = triggered_OUT_Trans(SCS,allTrans)
|
||||
val outlist = get_next_transitions(SCS,allTrans)
|
||||
val untriggered = ListDifference(triggered,outlist)
|
||||
val Final = FinalState(SV)
|
||||
fun createIncList 0 = []
|
||||
| createIncList n = (createIncList (n-1))@[n]
|
||||
fun handleUntriggered([],_) = []
|
||||
| handleUntriggered(h::t,T_id) = T_mk{trans_id = "newUT_"^Int.toString(T_id),
|
||||
source = id_of_state(Final),
|
||||
target = target_of_trans(h),
|
||||
guard = guard_of_trans(h),
|
||||
trigger = trigger_of_trans(h),
|
||||
effect = effect_of_trans(h)}::handleUntriggered(t,(T_id+1))
|
||||
fun createTrans T_id T S = T_mk{trans_id = T_id,
|
||||
source = S,
|
||||
target = target_of_trans(T),
|
||||
guard = guard_of_trans(T),
|
||||
trigger = trigger_of_trans(T),
|
||||
effect = effect_of_trans(T)}
|
||||
fun applyList([],_) = []
|
||||
| applyList(h::t,fList) = (List.map (fn X => X(h)) fList)@applyList(t,fList)
|
||||
|
||||
fun handleTriggered([],_) = []
|
||||
| handleTriggered(h::t,T_id) = let val idList = List.map (fn X => Int.toString(T_id)^"_"^Int.toString(X)) (createIncList subvertex_count)
|
||||
val funList = (List.map (fn X => X(h)) (List.map createTrans idList))
|
||||
in
|
||||
applyList(subverticesID,funList)@handleTriggered(t,(T_id+1))
|
||||
end
|
||||
val newTriggered = handleTriggered(triggered,0)
|
||||
val newUTriggered = handleUntriggered(untriggered,0)
|
||||
in
|
||||
correctCompositeTransitions(tail,
|
||||
newTrans@newTriggered@newUTriggered,
|
||||
allTrans)
|
||||
end
|
||||
| correctCompositeTransitions((SCS as State_CompositeState{name,state_id,outgoing,incoming,
|
||||
subvertex,isConcurrent})::tail,
|
||||
newTrans, allTrans) =
|
||||
let val SV = subvertices_of(SCS)
|
||||
val subverticesID = List.map id_of_state SV
|
||||
val subvertex_count = List.length(SV)
|
||||
val triggered = triggered_OUT_Trans(SCS,allTrans)
|
||||
val outlist = get_next_transitions(SCS,allTrans)
|
||||
val untriggered = ListDifference(triggered,outlist)
|
||||
val Final = FinalState(SV)
|
||||
fun createIncList 0 = []
|
||||
| createIncList n = (createIncList (n-1))@[n]
|
||||
fun handleUntriggered ([]:Transition list,_) = []
|
||||
| handleUntriggered (h::t,T_id) = {trans_id = "newUT_"^Int.toString(T_id),
|
||||
source = id_of_state(Final),
|
||||
target = #target(h),
|
||||
guard = #guard(h),
|
||||
trigger = #trigger(h),
|
||||
effect = #effect(h)}::handleUntriggered(t,(T_id+1))
|
||||
fun createTrans T_id (T:Transition) S = {trans_id = T_id,
|
||||
source = S,
|
||||
target = #target(T),
|
||||
guard = #guard(T),
|
||||
trigger = #trigger(T),
|
||||
effect = #effect(T)}
|
||||
fun applyList([],_) = []
|
||||
| applyList(h::t,fList) = (List.map (fn X => X(h)) fList)@applyList(t,fList)
|
||||
|
||||
fun handleTriggered([],_) = []
|
||||
| handleTriggered(h::t,T_id) =
|
||||
let val idList = List.map (fn X => Int.toString(T_id)^"_"^Int.toString(X))
|
||||
(createIncList subvertex_count)
|
||||
val funList = (List.map (fn X => X(h)) (List.map createTrans idList))
|
||||
in
|
||||
applyList(subverticesID,funList)@handleTriggered(t,(T_id+1))
|
||||
end
|
||||
val newTriggered = handleTriggered(triggered,0)
|
||||
val newUTriggered = handleUntriggered(untriggered,0)
|
||||
in
|
||||
correctCompositeTransitions(tail,
|
||||
newTrans@newTriggered@newUTriggered,
|
||||
allTrans)
|
||||
end
|
||||
| correctCompositeTransitions(h::t,nt,at) = correctCompositeTransitions(t,nt,at)
|
||||
|
||||
|
||||
(* StateVertex list * Transition list -> StateVertex list *)
|
||||
fun updateStates([],_) = []
|
||||
| updateStates(h::t,Transitions) = let val affectedOutTransitions = List.filter (fn X => source_of_trans(X) = id_of_state(h)) Transitions (* transitions that source from h *)
|
||||
val affectedInTransitions = List.filter (fn X => target_of_trans(X) = id_of_state(h)) Transitions
|
||||
val newOut = createDistinct((List.map id_of_trans affectedOutTransitions)@get_next_transitions_ID(h))
|
||||
val newIn = createDistinct((List.map id_of_trans affectedInTransitions)@get_prev_transitions_T(h))
|
||||
fun updateState(State_CompositeState{name=n,state_id=sid,outgoing=ol,incoming=il,subvertex=sv,isConcurrent=c}) = State_CompositeState{name=n,state_id=sid,outgoing=ol@newOut,incoming=il@newIn,subvertex=sv,isConcurrent=c}
|
||||
| updateState(State_SimpleState{name=n,state_id=sid,outgoing=ol,incoming=il}) = State_SimpleState{name=n,state_id=sid,outgoing=ol@newOut,incoming=il@newIn}
|
||||
| updateState(SimpleState_ActionState{name=n,state_id=sid,outgoing=ol,incoming=il,isDynamic=d}) = SimpleState_ActionState{name=n,state_id=sid,outgoing=ol@newOut,incoming=il@newIn,isDynamic=d}
|
||||
| updateState(SimpleState_ObjectflowState{state_id=sid,outgoing=ol,incoming=il,isSynch=s,parameter=p,types=t}) = SimpleState_ObjectflowState{state_id=sid,outgoing=ol,incoming=il,isSynch=s,parameter=p,types=t}
|
||||
| updateState(State_FinalState{state_id=sid,incoming=il}) = State_FinalState{state_id=sid,incoming=il@newIn}
|
||||
| updateState(PseudoState{state_id=sid,kind=k,outgoing=ol,incoming=il}) = PseudoState{state_id=sid,kind=k,outgoing=ol@newOut,incoming=il@newIn}
|
||||
| updateState(SyncState{state_id=sid,outgoing=ol,incoming=il}) = SyncState{state_id=sid,outgoing=ol@newOut,incoming=il@newIn}
|
||||
in
|
||||
updateState(h)::updateStates(t,Transitions)
|
||||
end
|
||||
fun updateStates([],_:Transition list) = []
|
||||
| updateStates(h::t,Transitions) =
|
||||
let val affectedOutTransitions = List.filter (fn X => #source X = id_of_state h)
|
||||
Transitions (* transitions that source from h *)
|
||||
val affectedInTransitions = List.filter (fn X => #target(X) = id_of_state(h))
|
||||
Transitions
|
||||
val newOut = makeDistinct((List.map #trans_id affectedOutTransitions)@outgoing_of(h))
|
||||
val newIn = makeDistinct((List.map #trans_id affectedInTransitions)@incoming_of(h))
|
||||
|
||||
fun updateState s = add_incoming (add_outgoing s newOut) newIn
|
||||
in
|
||||
updateState(h)::updateStates(t,Transitions)
|
||||
end
|
||||
|
||||
|
||||
(*
|
||||
T: Transition
|
||||
TL: Transition list ref (all)
|
||||
SL: (State * parent) list ref (all)
|
||||
TL: Transition list ref (all)
|
||||
SL: (State * parent) list ref (all)
|
||||
|
||||
for every transition T we calculate the propper transition list to every target state.
|
||||
I.e. we "divide out" the CompositeStates and the PseudoStates.
|
||||
*)
|
||||
fun CollectTGE(T, TL, SL) = let val S = get_state_by_id(target_of_trans(T), SL)
|
||||
val TRIGGER = trigger_of_trans(T)
|
||||
val GUARD = guard_of_trans(T)
|
||||
val EFFECT = effect_of_trans(T)
|
||||
val NEXTL = get_next_transitions(S,TL)
|
||||
fun ADD(L1,L2,L3,S) = (GUARD::L1,TRIGGER::L2,EFFECT::L3,S)
|
||||
in
|
||||
if isPseudo(S) orelse isInit(S) then List.map ADD (List.concat (List.map (fn X => CollectTGE(X,TL,SL)) NEXTL))
|
||||
else [([GUARD],[TRIGGER],[EFFECT],target_of_trans(T))]
|
||||
end
|
||||
for every transition T we calculate the propper transition list to every target state.
|
||||
I.e. we "divide out" the CompositeStates and the PseudoStates.
|
||||
*)
|
||||
fun CollectTGE(T, TL, SL) =
|
||||
let val S = get_state_by_id(#target(T), SL)
|
||||
val TRIGGER = #trigger(T)
|
||||
val GUARD = #guard(T)
|
||||
val EFFECT = #effect(T)
|
||||
val NEXTL = get_next_transitions(S,TL)
|
||||
fun ADD(L1,L2,L3,S) = (GUARD::L1,TRIGGER::L2,EFFECT::L3,S)
|
||||
in
|
||||
if isPseudo(S) orelse isInit(S)
|
||||
then List.map ADD (List.concat (List.map (fn X => CollectTGE(X,TL,SL)) NEXTL))
|
||||
else [([GUARD],[TRIGGER],[EFFECT],#target(T))]
|
||||
end
|
||||
|
||||
(* add transitions of to the out-states of the 'parent' states inside a composite state *)
|
||||
(* NOTE: has to be called with a list of states that does NOT contain pseudo states!!*)
|
||||
|
||||
(* StateVertex list * Transition list * Transition list * StateVertex list -> SM_Trans list list *)
|
||||
fun calculate_SM_Trans([],_,_,_) = []
|
||||
| calculate_SM_Trans((SCS as State_CompositeState{name,state_id,outgoing,incoming,subvertex,isConcurrent})::t,
|
||||
Parent_OutList,
|
||||
TransList,
|
||||
StateList) = let val outlist = get_next_transitions(SCS, ref TransList)
|
||||
in
|
||||
calculate_SM_Trans(subvertex,
|
||||
Parent_OutList@outlist,
|
||||
TransList,
|
||||
StateList)@calculate_SM_Trans(t,
|
||||
Parent_OutList,
|
||||
TransList,
|
||||
StateList)
|
||||
end
|
||||
| calculate_SM_Trans(h::t,
|
||||
Parent_OutList:Transition list,
|
||||
TransList:Transition list,
|
||||
StateList:StateVertex list) = let val outlist = get_next_transitions(h,ref TransList):Transition list
|
||||
val TL = List.concat (List.map (fn X => CollectTGE(X,ref TransList,ref StateList)) outlist)
|
||||
val UTriggeredParentT = List.concat (List.map (fn X => CollectTGE(X,ref TransList, ref StateList)) (List.filter (fn X => not(isTriggered(X))) Parent_OutList))
|
||||
val TriggeredParentT = List.concat (List.map (fn X => CollectTGE(X,ref TransList, ref StateList)) (List.filter isTriggered Parent_OutList))
|
||||
val ParentT = List.concat (List.map (fn X => CollectTGE(X,ref TransList, ref StateList)) Parent_OutList)
|
||||
fun getValOfOptionList(LIST) = List.map (fn X =>Option.valOf(X)) (List.filter Option.isSome LIST)
|
||||
fun Path2SM_Trans Source (Guards,Events,Effects,Target) = { trans_id = "nothing",
|
||||
source = Source,
|
||||
target = Target,
|
||||
guards = Guards,
|
||||
triggers = Events,
|
||||
effects = Effects
|
||||
}:SM_Trans
|
||||
val PList = List.map (fn (a,b,c,d) => (getValOfOptionList(a),getValOfOptionList(b),getValOfOptionList(c),d)) TL
|
||||
val TriggeredPPList = List.map (fn (a,b,c,d) => (getValOfOptionList(a),getValOfOptionList(b),getValOfOptionList(c),d)) TriggeredParentT
|
||||
val PPList = List.map (fn (a,b,c,d) => (getValOfOptionList(a),getValOfOptionList(b),getValOfOptionList(c),d)) ParentT
|
||||
val UTriggeredPPList = List.map (fn (a,b,c,d) => (getValOfOptionList(a),getValOfOptionList(b),getValOfOptionList(c),d)) UTriggeredParentT
|
||||
val SM_TransL = if isFinal(h) then (List.map (Path2SM_Trans (id_of_state(h))) (PList@PPList))
|
||||
else List.map (Path2SM_Trans (id_of_state(h))) (PList@TriggeredPPList)
|
||||
in
|
||||
SM_TransL::calculate_SM_Trans(t,Parent_OutList,TransList,StateList)
|
||||
end
|
||||
| calculate_SM_Trans((SCS as State_CompositeState{name,state_id,outgoing,incoming,
|
||||
subvertex,isConcurrent})::t,
|
||||
Parent_OutList, TransList, StateList) =
|
||||
let val outlist = get_next_transitions(SCS, ref TransList)
|
||||
in
|
||||
calculate_SM_Trans(subvertex,
|
||||
Parent_OutList@outlist,
|
||||
TransList,
|
||||
StateList)@calculate_SM_Trans(t, Parent_OutList, TransList, StateList)
|
||||
end
|
||||
| calculate_SM_Trans(h::t, Parent_OutList:Transition list, TransList:Transition list,
|
||||
StateList:StateVertex list) =
|
||||
let val outlist = get_next_transitions(h,ref TransList):Transition list
|
||||
val TL = List.concat (List.map (fn X => CollectTGE(X,ref TransList,ref StateList)) outlist)
|
||||
val UTriggeredParentT =
|
||||
List.concat (List.map (fn X => CollectTGE(X,ref TransList, ref StateList))
|
||||
(List.filter (fn X => not(isTriggered(X))) Parent_OutList))
|
||||
val TriggeredParentT =
|
||||
List.concat (List.map (fn X => CollectTGE(X,ref TransList, ref StateList))
|
||||
(List.filter isTriggered Parent_OutList))
|
||||
val ParentT = List.concat (List.map (fn X => CollectTGE(X,ref TransList, ref StateList))
|
||||
Parent_OutList)
|
||||
fun getValOfOptionList(LIST) = List.map (fn X =>Option.valOf(X))
|
||||
(List.filter Option.isSome LIST)
|
||||
fun Path2SM_Trans Source (Guards,Events,Effects,Target) = { trans_id = "nothing",
|
||||
source = Source,
|
||||
target = Target,
|
||||
guards = Guards,
|
||||
triggers = Events,
|
||||
effects = Effects
|
||||
}:SM_Trans
|
||||
val PList = List.map (fn (a,b,c,d) => (getValOfOptionList(a),getValOfOptionList(b),getValOfOptionList(c),d)) TL
|
||||
val TriggeredPPList = List.map (fn (a,b,c,d) => (getValOfOptionList(a),getValOfOptionList(b),getValOfOptionList(c),d)) TriggeredParentT
|
||||
val PPList = List.map (fn (a,b,c,d) => (getValOfOptionList(a),getValOfOptionList(b),getValOfOptionList(c),d)) ParentT
|
||||
val UTriggeredPPList = List.map (fn (a,b,c,d) => (getValOfOptionList(a),getValOfOptionList(b),getValOfOptionList(c),d)) UTriggeredParentT
|
||||
val SM_TransL = if isFinal(h) then (List.map (Path2SM_Trans (id_of_state(h))) (PList@PPList))
|
||||
else List.map (Path2SM_Trans (id_of_state(h))) (PList@TriggeredPPList)
|
||||
in
|
||||
SM_TransL::calculate_SM_Trans(t,Parent_OutList,TransList,StateList)
|
||||
end
|
||||
|
||||
(* Classifier -> SM_Trans list *)
|
||||
fun SM_Trans_of_classif(C:Classifier) = let val SL = states_of_classif(C)
|
||||
val TL = correct_TransList(transitions_of_classif(C),ref SL)
|
||||
val TL = TL@correctCompositeTransitions(SL,[],ref TL)
|
||||
val SL = updateStates(SL,TL)
|
||||
val NPS = List.filter (fn X => (not (isPseudo(X)))) SL
|
||||
val rawTransList = createDistinct(List.concat(calculate_SM_Trans(NPS,[],TL,states_of_classif(C))))
|
||||
fun addAutoTriggers([]) = []
|
||||
| addAutoTriggers(h::t) = case triggers_of_SM_Trans(h)
|
||||
of [] => mk_SM_T((#trans_id h),
|
||||
(#source h),
|
||||
(#target h),
|
||||
(#guards h),
|
||||
[alwaysTrigger],
|
||||
(#effects h))::addAutoTriggers(t)
|
||||
| _ => h::addAutoTriggers(t)
|
||||
fun addAutoGuards([]) = []
|
||||
| addAutoGuards(h::t) = case guards_of_SM_Trans(h)
|
||||
of [] => mk_SM_T((#trans_id h),
|
||||
(#source h),
|
||||
(#target h),
|
||||
[alwaysGuard],
|
||||
(#triggers h),
|
||||
(#effects h))::addAutoGuards(t)
|
||||
| _ => h::addAutoGuards(t)
|
||||
in
|
||||
addAutoGuards(addAutoTriggers(rawTransList))
|
||||
end
|
||||
fun SM_Trans_of_classif (C:Classifier) =
|
||||
let val SL = states_of_classif(C)
|
||||
val TL = correct_TransList(transitions_of_classif(C),ref SL)
|
||||
val TL = TL@correctCompositeTransitions(SL,[],ref TL)
|
||||
val SL = updateStates(SL,TL)
|
||||
val NPS = List.filter (fn X => (not (isPseudo(X)))) SL
|
||||
val rawTransList = makeDistinct (List.concat(calculate_SM_Trans(NPS,[],TL,states_of_classif(C))))
|
||||
fun addAutoTriggers([]) = []
|
||||
| addAutoTriggers(h::t) = case triggers_of_SM_Trans(h)
|
||||
of [] => mk_SM_T((#trans_id h),
|
||||
(#source h),
|
||||
(#target h),
|
||||
(#guards h),
|
||||
[alwaysTrigger],
|
||||
(#effects h))::addAutoTriggers(t)
|
||||
| _ => h::addAutoTriggers(t)
|
||||
fun addAutoGuards([]) = []
|
||||
| addAutoGuards(h::t) = case guards_of_SM_Trans(h)
|
||||
of [] => mk_SM_T((#trans_id h),
|
||||
(#source h),
|
||||
(#target h),
|
||||
[alwaysGuard],
|
||||
(#triggers h),
|
||||
(#effects h))::addAutoGuards(t)
|
||||
| _ => h::addAutoGuards(t)
|
||||
in
|
||||
addAutoGuards(addAutoTriggers(rawTransList))
|
||||
end
|
||||
|
||||
|
||||
(* SM_Trans list * Guard -> SM_Trans list *)
|
||||
(* Sorts the list L in such a way, that all SM_Transitions with guard G are at the end *)
|
||||
fun sort_SM_TransL_withGAtEnd(L,G) = let fun filterG({guards,...}:SM_Trans) = List.exists (fn X => X=G) guards
|
||||
val GL = List.filter filterG L
|
||||
val nGL = List.filter (fn X => not(filterG(X))) L
|
||||
in
|
||||
nGL@GL
|
||||
end
|
||||
fun sort_SM_TransL_withGAtEnd(L,G) =
|
||||
let fun filterG({guards,...}:SM_Trans) = List.exists (fn X => X=G) guards
|
||||
val GL = List.filter filterG L
|
||||
val nGL = List.filter (fn X => not(filterG(X))) L
|
||||
in
|
||||
nGL@GL
|
||||
end
|
||||
|
||||
(*FIXME - we have to discard the trigger-array and use a single trigger instead *)
|
||||
fun next_SM_Trans_4EV(S, TLp,E) = let fun filterS({source,...}:SM_Trans) = (source=id_of_state(S))
|
||||
fun filterE({triggers,...}:SM_Trans) = List.exists (fn X => X=E) triggers
|
||||
in
|
||||
List.filter filterE (List.filter filterS (!TLp))
|
||||
end
|
||||
fun next_SM_Trans_4EV(S, TLp,E) =
|
||||
let fun filterS({source,...}:SM_Trans) = (source=id_of_state(S))
|
||||
fun filterE({triggers,...}:SM_Trans) = List.exists (fn X => X=E) triggers
|
||||
in
|
||||
List.filter filterE (List.filter filterS (!TLp))
|
||||
end
|
||||
(* effects_of_SM_Trans = fn : SM_Trans -> Action list *)
|
||||
fun effects_of_SM_Trans({effects,...}: SM_Trans) = effects
|
||||
|
||||
fun ident_of_effect(Proc_mk{proc_id,...}) = proc_id
|
||||
(* fun ident_of_effect ({proc_id,...}:Procedure) = proc_id*)
|
||||
|
||||
fun is_TopState(S as State_CompositeState{...},C:Classifier) = let val top = top_state_of(hd (ActGraph_of_classif(C)))
|
||||
val dbt = print(id_of_state(top))
|
||||
in
|
||||
S = top
|
||||
end
|
||||
fun is_TopState(S as State_CompositeState{...},C:Classifier) =
|
||||
let val top = #top (hd (activity_graphs_of C))
|
||||
val dbt = print(id_of_state(top))
|
||||
in
|
||||
S = top
|
||||
end
|
||||
| is_TopState(_,_) = false
|
||||
|
||||
|
||||
fun realInit(C:Classifier) = let val TopState = top_state_of(hd(ActGraph_of_classif(C)))
|
||||
val subvertices = get_subvertex_list(TopState)
|
||||
val InitL = List.filter is_StartState subvertices
|
||||
in
|
||||
case InitL
|
||||
of [] => raise MalformedStateMachine
|
||||
| [x] => x
|
||||
| _ => raise MalformedStateMachine
|
||||
end
|
||||
(* Codegen.generate (Rep_SecureUML_ComponentUML.readXMI "examples/Chessboard_composite.xmi") "c#_sm_VIZ"; *)
|
||||
fun realInit (c:Classifier) = (get_initial o subvertices_of o #top o hd o activity_graphs_of) c
|
||||
|
||||
|
||||
end
|
||||
|
|
|
|||
|
|
@ -1,49 +1,22 @@
|
|||
(** convenience functions for handling strings. *)
|
||||
structure StringHandling =
|
||||
struct
|
||||
|
||||
open library
|
||||
|
||||
(** returns the string in all caps. *)
|
||||
fun toUpper (s:string) = String.map Char.toUpper s
|
||||
|
||||
(** returns the uncapitalized string. *)
|
||||
fun uncapitalize (s:string) = let val sl = String.explode s
|
||||
in
|
||||
String.implode ((Char.toLower (hd sl))::(tl sl))
|
||||
end
|
||||
|
||||
(** returns the capitalized string. *)
|
||||
fun toUpper(S:string) = String.implode (List.map Char.toUpper (String.explode S))
|
||||
|
||||
(*reassemble given string list by concatenating every time the string character to each element and return the whole as a string *)
|
||||
(* string list * string -> string *)
|
||||
fun reassemble(S: string list,c : string) = String.concat (List.map (fn x => x^c) S)
|
||||
fun concatBefore(S: string list, c: string) = String.concat (List.map (fn x =>c^x) S)
|
||||
|
||||
(* Pair list * string -> string *)
|
||||
fun replace_vars_in_String(L:(string*string) list,Str) =
|
||||
let val LINES = String.tokens (fn x => x = #"\n") Str
|
||||
fun isVariable(S) = (List.length (List.filter (fn x => x = #"$") (String.explode S))) = 2 (*string->bool*)
|
||||
fun isEqual(s1:string,s2:string) = (s1<=s2) andalso (s1>=s2)(*string*string -> bool*)
|
||||
fun filterOut(VarName) = List.filter (fn X => isEqual(fst(X),VarName)) L(*string -> Pair list*)
|
||||
fun VarIt(x) = String.tokens (fn x => x = #"$") x
|
||||
fun process([],R) = R
|
||||
| process(h::t,R) = let val Filtered = filterOut(h)
|
||||
in
|
||||
if (List.length Filtered) > 0 then process(t,R@[snd(hd Filtered)])
|
||||
else process(t,R@[h])
|
||||
end
|
||||
fun replace(Str) = let val TABBED = String.tokens (fn x => x = #"\t") Str
|
||||
val VARRED = List.map VarIt TABBED
|
||||
val P = List.map (fn X => process(X,[])) VARRED
|
||||
in
|
||||
String.concatWith "\t" (List.map (fn X => (String.concatWith "" X)) P)
|
||||
end
|
||||
in
|
||||
String.concatWith "\n" (List.map replace LINES)
|
||||
end
|
||||
|
||||
|
||||
fun startWithSmallLetter s = let val sl = String.explode s
|
||||
in
|
||||
String.implode ((Char.toLower (hd sl))::(tl sl))
|
||||
end
|
||||
|
||||
fun startWithCapital s = let val sl = String.explode s
|
||||
in
|
||||
String.implode ((Char.toUpper (hd sl))::(tl sl))
|
||||
end
|
||||
|
||||
fun capitalize (s:string) = let val sl = String.explode s
|
||||
in
|
||||
String.implode ((Char.toUpper (hd sl))::(tl sl))
|
||||
end
|
||||
|
||||
|
||||
end
|
||||
|
|
|
|||
|
|
@ -80,6 +80,7 @@ datatype TemplateTree = RootNode of TemplateTree list
|
|||
(**
|
||||
* replaceSafely (s,v,x) replaces every v that occurs unescaped in s with x.
|
||||
* if v occurs escaped with "\" in s, then the "\" is removed from s.
|
||||
* FIXME: move to stringhandling?
|
||||
*)
|
||||
fun replaceSafely _ _ "" = ""
|
||||
| replaceSafely v x s =
|
||||
|
|
@ -95,7 +96,8 @@ fun replaceSafely _ _ "" = ""
|
|||
|
||||
|
||||
(** removes leading, trainling, and multiple consecutive whitespace chars. *)
|
||||
fun cleanLine s = String.concatWith " " (String.tokens Char.isSpace s)
|
||||
(* FIXME: movev to StringHandling? *)
|
||||
fun cleanLine s = String.concatWith " " (String.tokens Char.isSpace s)
|
||||
|
||||
|
||||
(* debugging function
|
||||
|
|
@ -149,10 +151,7 @@ fun getContent l = let val sl = tokenize l
|
|||
else String.concat (tl (fieldSplit #" " (String.concat (tl sl))))
|
||||
end
|
||||
|
||||
(**
|
||||
* cleans line, replaces nl and tabs
|
||||
* so that no space char is left out
|
||||
*)
|
||||
(** cleans line, replaces nl and tabs so that no space char is left out. *)
|
||||
fun preprocess s = replaceSafely "@tab" "\t" (replaceSafely "@nl" "\n" (cleanLine s))
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -9,6 +9,9 @@ sig
|
|||
|
||||
(** checks whether the lists are disjunct, i.e., do not overlap. *)
|
||||
val disjunct: ''a list -> ''a list -> bool
|
||||
|
||||
(** removes duplicate elements. *)
|
||||
val makeDistinct: ''a list -> ''a list
|
||||
end
|
||||
|
||||
|
||||
|
|
@ -25,4 +28,8 @@ fun overlaps xs ys = includes (map (includes xs) ys) true
|
|||
(** checks whether the lists are disjunct, i.e., do not overlap. *)
|
||||
fun disjunct xs ys = not (overlaps xs ys)
|
||||
|
||||
(** removes duplicate elements. *)
|
||||
fun makeDistinct [] = []
|
||||
| makeDistinct (h::t) = h::makeDistinct (List.filter (fn x => not (x=h)) t)
|
||||
|
||||
end
|
||||
|
|
|
|||
|
|
@ -122,6 +122,7 @@ val operations_of : Classifier -> operation list
|
|||
val invariant_of : Classifier -> (string option * Rep_OclTerm.OclTerm) list
|
||||
val stereotypes_of : Classifier -> string list
|
||||
val string_of_path : string list -> string
|
||||
val activity_graphs_of: Classifier -> Rep_ActivityGraph.ActivityGraph list
|
||||
|
||||
val arguments_of_op : operation -> (string * Rep_OclType.OclType) list
|
||||
val precondition_of_op : operation -> (string option * Rep_OclTerm.OclTerm) list
|
||||
|
|
@ -620,6 +621,11 @@ fun parents_of C cl = case parent_name_of C of
|
|||
| class => (if( class = (name_of OclAnyC) )
|
||||
then [(name_of OclAnyC)]
|
||||
else [class]@(parents_of (class_of class cl) cl))
|
||||
|
||||
(* returns the activity graphs (list) of the given Classifier --> this is a list of StateMachines*)
|
||||
(* Classifier -> ActivityGraph list *)
|
||||
fun activity_graphs_of (Class{activity_graphs,...}) = activity_graphs
|
||||
| activity_graphs_of _ = []
|
||||
|
||||
fun operation_of cl fq_name =
|
||||
let
|
||||
|
|
|
|||
|
|
@ -309,27 +309,27 @@ fun transform_event t (XMI.CallEvent ev) =
|
|||
Rep.SignalEvent (map (transform_parameter t) (#parameter ev))
|
||||
|
||||
fun transform_proc t (XMI.mk_Procedure proc) =
|
||||
Rep.Proc_mk { proc_id = #xmiid proc,
|
||||
language = #language proc,
|
||||
body = #body proc,
|
||||
expression = #expression proc }
|
||||
|
||||
fun transform_transition t (XMI.mk_Transition trans)
|
||||
= Rep.T_mk { trans_id = #xmiid trans ,
|
||||
source = #source trans,
|
||||
target = #target trans,
|
||||
guard = Option.map (transform_guard t) (#guard trans),
|
||||
trigger = Option.map ((transform_event t) o (find_event t))
|
||||
(#trigger trans),
|
||||
effect = Option.map (transform_proc t) (#effect trans)}
|
||||
|
||||
{ proc_id = #xmiid proc,
|
||||
language = #language proc,
|
||||
body = #body proc,
|
||||
expression = #expression proc }
|
||||
|
||||
fun transform_transition t (XMI.mk_Transition trans) =
|
||||
{ trans_id = #xmiid trans ,
|
||||
source = #source trans,
|
||||
target = #target trans,
|
||||
guard = Option.map (transform_guard t) (#guard trans),
|
||||
trigger = Option.map ((transform_event t) o (find_event t))
|
||||
(#trigger trans),
|
||||
effect = Option.map (transform_proc t) (#effect trans)}
|
||||
|
||||
fun transform_activitygraph t (XMI.mk_ActivityGraph act) =
|
||||
Rep_StateMachine.SM_mk {top = transform_state t (#top act),
|
||||
transition = map (transform_transition t) (#transitions act) }
|
||||
{top = transform_state t (#top act),
|
||||
transition = map (transform_transition t) (#transitions act) }
|
||||
|
||||
fun transform_statemachine t (XMI.mk_StateMachine st) =
|
||||
Rep_StateMachine.SM_mk {top = transform_state t (#top st),
|
||||
transition = map (transform_transition t) (#transitions st) }
|
||||
{top = transform_state t (#top st),
|
||||
transition = map (transform_transition t) (#transitions st) }
|
||||
|
||||
(** transform a XMI.Classifier classifier into a Rep.Classifier *)
|
||||
fun transform_classifier t (XMI.Class {xmiid,name,isActive,visibility,isLeaf,
|
||||
|
|
|
|||
|
|
@ -29,37 +29,24 @@ sig
|
|||
|
||||
type StateVertex_Id
|
||||
type Transition_Id
|
||||
|
||||
datatype Procedure = Proc_mk of {proc_id : string,
|
||||
language : string,
|
||||
body : string,
|
||||
expression : string }
|
||||
|
||||
(* perhaps this type has to be changes according to what we can expect *)
|
||||
(* from CASE tools *)
|
||||
type Guard = Rep_OclTerm.OclTerm
|
||||
|
||||
type Procedure
|
||||
type Guard = Rep_OclTerm.OclTerm
|
||||
|
||||
type Parameter = string * Rep_OclType.OclType
|
||||
|
||||
|
||||
datatype Event = SignalEvent of Parameter list
|
||||
| CallEvent of Rep_OclType.Path * Parameter list
|
||||
| CallEvent of Rep_OclType.Path * Parameter list
|
||||
(* | TimeEvent of Parameter list *)
|
||||
(* | ChangeEvent of Parameter list *)
|
||||
|
||||
|
||||
datatype Transition = T_mk of {trans_id: Transition_Id,
|
||||
source : StateVertex_Id,
|
||||
target : StateVertex_Id,
|
||||
guard : Guard option,
|
||||
trigger : Event option,
|
||||
effect : Procedure option
|
||||
(* mmm : StateVertexId option *)
|
||||
}
|
||||
|
||||
type Transition
|
||||
|
||||
|
||||
type PseudoStateVars = XMI_StateMachines.PseudoStateVars
|
||||
|
||||
datatype StateVertex =
|
||||
|
||||
|
||||
datatype StateVertex =
|
||||
State_CompositeState
|
||||
of {name : string,
|
||||
state_id : StateVertex_Id,
|
||||
|
|
@ -67,11 +54,11 @@ datatype StateVertex =
|
|||
incoming : Transition_Id list,
|
||||
subvertex : StateVertex list,
|
||||
isConcurrent : bool
|
||||
(* submachine : StateMachine *
|
||||
{isDynamic : bool
|
||||
(* + dynamicArguments
|
||||
+ dynamicMultiplicity *)} option *)}
|
||||
(* variant for Subactivity State *)
|
||||
(* submachine : StateMachine *
|
||||
{isDynamic : bool
|
||||
(* + dynamicArguments
|
||||
+ dynamicMultiplicity *)} option *)}
|
||||
(* variant for Subactivity State *)
|
||||
| State_SimpleState
|
||||
of {name : string,
|
||||
state_id : StateVertex_Id,
|
||||
|
|
@ -104,12 +91,30 @@ datatype StateVertex =
|
|||
outgoing : Transition_Id list,
|
||||
incoming : Transition_Id list}
|
||||
(* | StubState *)
|
||||
and StateMachine = SM_mk of {top : StateVertex,
|
||||
transition : Transition list}
|
||||
|
||||
withtype StateMachine = {top : StateVertex,
|
||||
transition : Transition list}
|
||||
|
||||
|
||||
val isInit : StateVertex -> bool
|
||||
val isPseudo : StateVertex -> bool
|
||||
val isFinal : StateVertex -> bool
|
||||
val isComposite : StateVertex -> bool
|
||||
|
||||
|
||||
val isTriggered : Transition -> bool
|
||||
|
||||
|
||||
val id_of_state : StateVertex -> string
|
||||
val name_of_state : StateVertex -> string
|
||||
val subvertices_of : StateVertex -> StateVertex list
|
||||
|
||||
val outgoing_of : StateVertex -> Transition_Id list
|
||||
val incoming_of : StateVertex -> Transition_Id list
|
||||
|
||||
val pseudo_state_kind_of : StateVertex -> PseudoStateVars
|
||||
|
||||
val add_outgoing : StateVertex -> Transition_Id list -> StateVertex
|
||||
val add_incoming : StateVertex -> Transition_Id list -> StateVertex
|
||||
|
||||
end
|
||||
|
||||
structure Rep_StateMachine : REP_STATE_MACHINE =
|
||||
|
|
@ -117,33 +122,31 @@ struct
|
|||
|
||||
type StateVertex_Id = string
|
||||
type Transition_Id = string
|
||||
|
||||
|
||||
type Procedure = {proc_id : string,
|
||||
language : string,
|
||||
body : string,
|
||||
expression : string }
|
||||
|
||||
type Guard = Rep_OclTerm.OclTerm
|
||||
|
||||
type Parameter = string * Rep_OclType.OclType
|
||||
|
||||
datatype Procedure = Proc_mk of {proc_id : string,
|
||||
language : string,
|
||||
body : string,
|
||||
expression : string }
|
||||
|
||||
type Guard = Rep_OclTerm.OclTerm
|
||||
type Parameter = string * Rep_OclType.OclType
|
||||
|
||||
datatype Event = SignalEvent of Parameter list
|
||||
| CallEvent of Rep_OclType.Path * Parameter list
|
||||
(* | TimeEvent of Parameter list *)
|
||||
(* | ChangeEvent of Parameter list *)
|
||||
| CallEvent of Rep_OclType.Path * Parameter list
|
||||
(* | TimeEvent of Parameter list *)
|
||||
(* | ChangeEvent of Parameter list *)
|
||||
|
||||
|
||||
|
||||
datatype Transition = T_mk of {trans_id : Transition_Id,
|
||||
source : StateVertex_Id,
|
||||
target : StateVertex_Id,
|
||||
guard : Guard option,
|
||||
trigger : Event option,
|
||||
effect : Procedure option
|
||||
(* mmm : StateVertexId option *)
|
||||
}
|
||||
|
||||
|
||||
type Transition = {trans_id : Transition_Id,
|
||||
source : StateVertex_Id,
|
||||
target : StateVertex_Id,
|
||||
guard : Guard option,
|
||||
trigger : Event option,
|
||||
effect : Procedure option
|
||||
(* mmm : StateVertexId option *)
|
||||
}
|
||||
|
||||
type PseudoStateVars = XMI_StateMachines.PseudoStateVars
|
||||
|
||||
datatype StateVertex =
|
||||
|
|
@ -191,8 +194,146 @@ datatype StateVertex =
|
|||
outgoing : Transition_Id list,
|
||||
incoming : Transition_Id list}
|
||||
(* | StubState *)
|
||||
and StateMachine = SM_mk of {top : StateVertex,
|
||||
transition : Transition list}
|
||||
withtype StateMachine = {top : StateVertex,
|
||||
transition : Transition list}
|
||||
|
||||
|
||||
|
||||
(* StateVertex -> StateVertex_Id *)
|
||||
fun id_of_state (State_SimpleState{state_id,...}) = state_id
|
||||
| id_of_state (State_CompositeState{state_id,...}) = state_id
|
||||
| id_of_state (SimpleState_ActionState{state_id,...}) = state_id
|
||||
| id_of_state (SimpleState_ObjectflowState{state_id,...}) = state_id
|
||||
| id_of_state (State_FinalState{state_id,...}) = state_id
|
||||
| id_of_state (PseudoState{state_id,...}) = state_id
|
||||
| id_of_state (SyncState{state_id,...}) = state_id
|
||||
|
||||
fun name_of_state (State_SimpleState{name,...}) = name
|
||||
| name_of_state (State_CompositeState{name,...}) = name
|
||||
| name_of_state (SimpleState_ActionState{name,...}) = name
|
||||
| name_of_state (State_FinalState{...}) = "Final"
|
||||
| name_of_state (S as PseudoState{kind,...}) = case kind
|
||||
of XMI.initial => "INIT"^id_of_state(S)
|
||||
| XMI.junction => "ERROR"
|
||||
| _ => "WRONG"
|
||||
|
||||
(** returns the list of subvertices. *)
|
||||
fun subvertices_of (State_CompositeState{subvertex,...}) = subvertex
|
||||
| subvertices_of _ = []
|
||||
|
||||
|
||||
fun pseudo_state_kind_of (PseudoState{kind,...}) = kind
|
||||
|
||||
(* cough. *)
|
||||
fun isPseudo (PseudoState{kind,...}) = not(kind=XMI.initial)
|
||||
| isPseudo _ = false
|
||||
|
||||
fun isInit (PseudoState{kind,...}) = kind=XMI.initial
|
||||
| isInit _ = false
|
||||
|
||||
fun isFinal (State_FinalState{...}) = true
|
||||
| isFinal _ = false
|
||||
|
||||
fun isComposite (State_CompositeState{...}) = true
|
||||
| isComposite _ = false
|
||||
|
||||
fun outgoing_of (State_SimpleState{outgoing,...}) = outgoing
|
||||
| outgoing_of (State_CompositeState{outgoing,...}) = outgoing
|
||||
| outgoing_of (SimpleState_ActionState{outgoing,...}) = outgoing
|
||||
| outgoing_of (SimpleState_ObjectflowState{outgoing,...}) = outgoing
|
||||
| outgoing_of (State_FinalState{...}) = []
|
||||
| outgoing_of (PseudoState{outgoing,...}) = outgoing
|
||||
| outgoing_of (SyncState{outgoing,...}) = outgoing
|
||||
|
||||
fun incoming_of (State_SimpleState{incoming,...}) = incoming
|
||||
| incoming_of (State_CompositeState{incoming,...}) = incoming
|
||||
| incoming_of (SimpleState_ActionState{incoming,...}) = incoming
|
||||
| incoming_of (SimpleState_ObjectflowState{incoming,...}) = incoming
|
||||
| incoming_of (State_FinalState{incoming,...}) = incoming
|
||||
| incoming_of (PseudoState{incoming,...}) = incoming
|
||||
| incoming_of (SyncState{incoming,...}) = incoming
|
||||
|
||||
fun isTriggered (t:Transition) = Option.isSome (#trigger t)
|
||||
|
||||
|
||||
fun add_outgoing (State_CompositeState {name,state_id,outgoing,incoming,
|
||||
subvertex,isConcurrent}) newOut =
|
||||
State_CompositeState{name=name,
|
||||
state_id=state_id,
|
||||
outgoing=outgoing@newOut,
|
||||
incoming=incoming,
|
||||
subvertex=subvertex,
|
||||
isConcurrent=isConcurrent}
|
||||
| add_outgoing (State_SimpleState{name=n,state_id=sid,outgoing=ol,incoming=il}) newOut =
|
||||
State_SimpleState{ name=n,
|
||||
state_id=sid,
|
||||
outgoing=ol@newOut,
|
||||
incoming=il}
|
||||
| add_outgoing (SimpleState_ActionState{name=n,state_id=sid,outgoing=ol,
|
||||
incoming=il,isDynamic=d}) newOut =
|
||||
SimpleState_ActionState{ name=n,
|
||||
state_id=sid,
|
||||
outgoing=ol@newOut,
|
||||
incoming=il,
|
||||
isDynamic=d}
|
||||
| add_outgoing (SimpleState_ObjectflowState{state_id=sid,outgoing=ol,incoming=il,
|
||||
isSynch=s,parameter=p,types=t}) newOut =
|
||||
SimpleState_ObjectflowState{ state_id=sid,
|
||||
outgoing=ol@newOut,
|
||||
incoming=il,
|
||||
isSynch=s,
|
||||
parameter=p,
|
||||
types=t}
|
||||
| add_outgoing (s as State_FinalState{state_id=sid,incoming=il}) newOut = s
|
||||
| add_outgoing (PseudoState{state_id=sid,kind=k,outgoing=ol,incoming=il}) newOut =
|
||||
PseudoState{ state_id=sid,
|
||||
kind=k,
|
||||
outgoing=ol@newOut,
|
||||
incoming=il}
|
||||
| add_outgoing (SyncState{state_id=sid,outgoing=ol,incoming=il}) newOut =
|
||||
SyncState {state_id=sid,
|
||||
outgoing=ol@newOut,
|
||||
incoming=il}
|
||||
|
||||
fun add_incoming (State_CompositeState{name=n,state_id=sid,outgoing=ol,
|
||||
incoming=il,subvertex=sv,isConcurrent=c}) newIn =
|
||||
State_CompositeState{ name=n,
|
||||
state_id=sid,
|
||||
outgoing=ol,
|
||||
incoming=il@newIn,
|
||||
subvertex=sv,
|
||||
isConcurrent=c}
|
||||
| add_incoming (State_SimpleState{name=n,state_id=sid,outgoing=ol,incoming=il}) newIn =
|
||||
State_SimpleState{name=n,
|
||||
state_id=sid,
|
||||
outgoing=ol,
|
||||
incoming=il@newIn}
|
||||
| add_incoming (SimpleState_ActionState{name=n,state_id=sid,outgoing=ol,
|
||||
incoming=il,isDynamic=d}) newIn =
|
||||
SimpleState_ActionState{name=n,
|
||||
state_id=sid,
|
||||
outgoing=ol,
|
||||
incoming=il@newIn,
|
||||
isDynamic=d}
|
||||
| add_incoming (SimpleState_ObjectflowState{state_id=sid,outgoing=ol,incoming=il,
|
||||
isSynch=s,parameter=p,types=t}) newIn =
|
||||
SimpleState_ObjectflowState{state_id=sid,
|
||||
outgoing=ol,
|
||||
incoming=il, (* FIXME? *)
|
||||
isSynch=s,
|
||||
parameter=p,
|
||||
types=t}
|
||||
| add_incoming (State_FinalState{state_id=sid,incoming=il}) newIn =
|
||||
State_FinalState{ state_id=sid,
|
||||
incoming=il@newIn}
|
||||
| add_incoming (PseudoState{ state_id=sid,kind=k,outgoing=ol,incoming=il}) newIn =
|
||||
PseudoState{ state_id=sid,
|
||||
kind=k,
|
||||
outgoing=ol,
|
||||
incoming=il@newIn}
|
||||
| add_incoming (SyncState{state_id=sid,outgoing=ol,incoming=il}) newIn =
|
||||
SyncState{ state_id=sid,
|
||||
outgoing=ol,
|
||||
incoming=il@newIn}
|
||||
|
||||
end
|
||||
|
|
|
|||
Loading…
Reference in New Issue