760 lines
34 KiB
Standard ML
760 lines
34 KiB
Standard ML
(*****************************************************************************
|
|
* su4sml --- an SML repository for managing (Secure)UML/OCL models
|
|
* http://projects.brucker.ch/su4sml/
|
|
*
|
|
* rep_parser.sml --- an xmi-parser for the import interface for su4sml
|
|
* This file is part of su4sml.
|
|
*
|
|
* Copyright (c) 2005-2007 ETH Zurich, Switzerland
|
|
* 2008-2009 Achim D. Brucker, Germany
|
|
*
|
|
* All rights reserved.
|
|
*
|
|
* Redistribution and use in source and binary forms, with or without
|
|
* modification, are permitted provided that the following conditions are
|
|
* met:
|
|
*
|
|
* * Redistributions of source code must retain the above copyright
|
|
* notice, this list of conditions and the following disclaimer.
|
|
*
|
|
* * Redistributions in binary form must reproduce the above
|
|
* copyright notice, this list of conditions and the following
|
|
* disclaimer in the documentation and/or other materials provided
|
|
* with the distribution.
|
|
*
|
|
* * Neither the name of the copyright holders nor the names of its
|
|
* contributors may be used to endorse or promote products derived
|
|
* from this software without specific prior written permission.
|
|
*
|
|
* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
|
* "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
|
|
* LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
|
|
* A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
|
|
* OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
|
|
* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
|
|
* LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
|
|
* DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
|
|
* THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
|
|
* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
|
* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
|
******************************************************************************)
|
|
(* $Id$ *)
|
|
|
|
structure RepParser :
|
|
sig
|
|
val transformXMI : XMI.XmiContent -> Rep.Classifier list
|
|
val transformXMI_ext : XMI.XmiContent -> Rep.transform_model
|
|
val readFile : string -> Rep.Model
|
|
val importArgoUML : string -> Rep.Model
|
|
(* val test: (string * string list) -> OS.Process.status *)
|
|
(* generic exception if something is wrong *)
|
|
end =
|
|
struct
|
|
|
|
open Xmi_IDTable
|
|
|
|
(* billk_tag *)
|
|
open Rep_OclTerm
|
|
open Rep_OclType
|
|
open Rep_OclHelper
|
|
open Rep_Core
|
|
|
|
(** thrown when something is not yet implemented *)
|
|
exception NotYetImplemented
|
|
|
|
val triv_expr = Rep_OclTerm.Literal ("true",Rep_OclType.Boolean)
|
|
|
|
(** transform an xmi ocl expression into a rep ocl term *)
|
|
fun transform_expression t (XMI.LiteralExp {symbol,expression_type}) =
|
|
Rep_OclTerm.Literal (symbol,find_classifier_type t expression_type)
|
|
| transform_expression t (XMI.CollectionLiteralExp {parts,expression_type}) =
|
|
Rep_OclTerm.CollectionLiteral (map (transform_collection_part t) parts,
|
|
find_classifier_type t expression_type)
|
|
| transform_expression t (XMI.IfExp {condition,thenExpression,
|
|
elseExpression,expression_type}) =
|
|
Rep_OclTerm.If (transform_expression t condition,
|
|
find_classifier_type t (XMI.expression_type_of condition),
|
|
transform_expression t thenExpression,
|
|
find_classifier_type t (XMI.expression_type_of thenExpression),
|
|
transform_expression t elseExpression,
|
|
find_classifier_type t (XMI.expression_type_of elseExpression),
|
|
find_classifier_type t expression_type)
|
|
| transform_expression t (XMI.AttributeCallExp {source,referredAttribute,
|
|
expression_type}) =
|
|
Rep_OclTerm.AttributeCall (transform_expression t source,
|
|
find_classifier_type t (XMI.expression_type_of source),
|
|
Xmi_IDTable.find_attribute t referredAttribute,
|
|
find_classifier_type t expression_type)
|
|
| transform_expression t (XMI.OperationCallExp {source,arguments,
|
|
referredOperation,
|
|
expression_type}) =
|
|
let val arglist = map (transform_expression t) arguments
|
|
val argtyplist = map ((find_classifier_type t) o XMI.expression_type_of) arguments
|
|
in
|
|
Rep_OclTerm.OperationCall (transform_expression t source,
|
|
find_classifier_type t (XMI.expression_type_of source),
|
|
Xmi_IDTable.find_operation t referredOperation,
|
|
ListPair.zip (arglist, argtyplist),
|
|
find_classifier_type t expression_type)
|
|
end
|
|
| transform_expression t (XMI.OperationWithTypeArgExp {source,name,
|
|
typeArgument,
|
|
expression_type}) =
|
|
Rep_OclTerm.OperationWithType (transform_expression t source,
|
|
find_classifier_type t (XMI.expression_type_of source),
|
|
name,
|
|
find_classifier_type t typeArgument,
|
|
find_classifier_type t expression_type)
|
|
| transform_expression t (XMI.VariableExp {referredVariable,expression_type})=
|
|
let val var_dec = find_variable_dec t referredVariable
|
|
val name = #name var_dec
|
|
val var_name = if name = ""
|
|
then "anonIterVar_"^ (#xmiid var_dec)
|
|
else name
|
|
in
|
|
Rep_OclTerm.Variable (var_name,find_classifier_type t expression_type)
|
|
end
|
|
| transform_expression t (XMI.AssociationEndCallExp {source, referredAssociationEnd, expression_type}) =
|
|
let fun find_type exp = let val cls = find_classifier_type
|
|
t (XMI.expression_type_of exp)
|
|
in case cls of
|
|
Rep_OclType.Classifier _ => cls
|
|
| OclAny => find_type (XMI.expression_source_of exp)
|
|
end
|
|
(* this is a bit problematic: an associationendcall should always
|
|
* have a (user-defined) classifier as source type. However, the
|
|
* atPre() operation call returns OclAny, which is not a classifier.
|
|
* Therefore, we look (recursively), at the source of the expression
|
|
* source until we find a user-defined classifier type and take this type.
|
|
* This works for the case of atPre(), but I'm not sure if there are other
|
|
* cases where this hack has unwanted consequences.
|
|
*)
|
|
val classifier_type = find_type source
|
|
val path_of_classifier = Rep_OclType.path_of_OclType classifier_type
|
|
val aend = find_associationend t referredAssociationEnd
|
|
val aend_name = Option.getOpt(#name aend,
|
|
(StringHandling.uncapitalize o XMI.classifier_name_of o
|
|
find_classifier t)
|
|
(#participant_id aend))
|
|
in Rep_OclTerm.AssociationEndCall
|
|
(transform_expression t source,
|
|
classifier_type,
|
|
path_of_classifier @ [aend_name],
|
|
find_classifier_type t expression_type)
|
|
end
|
|
| transform_expression t (XMI.IteratorExp {name,iterators,body,source,expression_type}) =
|
|
let val _ = map (insert_variable_dec t) iterators
|
|
in
|
|
Rep_OclTerm.Iterator (name,
|
|
map (fn x => (if #name x = ""
|
|
then "anonIterVar_" ^ (#xmiid x)
|
|
else #name x,
|
|
find_classifier_type t (#declaration_type x))) iterators,
|
|
transform_expression t source, find_classifier_type t (XMI.expression_type_of source),
|
|
transform_expression t body, find_classifier_type t (XMI.expression_type_of body),
|
|
find_classifier_type t expression_type
|
|
)
|
|
end
|
|
| transform_expression t (XMI.IterateExp {result,iterators,body,source,expression_type}) =
|
|
let val _ = map (insert_variable_dec t) (result::iterators )
|
|
in
|
|
Rep_OclTerm.Iterate ( map (fn x => (#name x, find_classifier_type t (#declaration_type x))) iterators,
|
|
#name result,
|
|
find_classifier_type t (#declaration_type result),
|
|
transform_expression t (valOf (#init result)),
|
|
transform_expression t source, find_classifier_type t (XMI.expression_type_of source),
|
|
transform_expression t body, find_classifier_type t (XMI.expression_type_of body),
|
|
find_classifier_type t expression_type
|
|
)
|
|
end
|
|
| transform_expression t (XMI.LetExp {variable, inExpression, expression_type}) =
|
|
let val _ = insert_variable_dec t variable
|
|
in
|
|
Rep_OclTerm.Let (#name variable,
|
|
find_classifier_type t (#declaration_type variable),
|
|
transform_expression t (Option.valOf (#init variable)),
|
|
find_classifier_type t (XMI.expression_type_of
|
|
(Option.valOf (#init variable))),
|
|
transform_expression t inExpression,
|
|
find_classifier_type t expression_type
|
|
)
|
|
end
|
|
| transform_expression t _ = Logger.error "unsupported OCL expression type"
|
|
and transform_collection_part t (XMI.CollectionItem {item,expression_type}) =
|
|
Rep_OclTerm.CollectionItem (transform_expression t item,
|
|
find_classifier_type t expression_type)
|
|
| transform_collection_part t (XMI.CollectionRange {first,last,expression_type}) =
|
|
Rep_OclTerm.CollectionRange (transform_expression t first,
|
|
transform_expression t last,
|
|
find_classifier_type t expression_type)
|
|
|
|
|
|
fun transform_constraint t ({xmiid,name,body,...}:XMI.Constraint) =
|
|
let val n_name = case name of
|
|
(SOME s) => if (s = "") then NONE else (SOME(s))
|
|
| NONE => NONE
|
|
in
|
|
(n_name,transform_expression t body)
|
|
handle ex => (Logger.warn ("Warning: in RepParser.transform_constraint: \
|
|
\Could not parse Constraint: "^General.exnMessage ex^"\n"^
|
|
"using the trivial constraint 'true' instead");
|
|
(NONE, triv_expr))
|
|
end
|
|
|
|
fun transform_bodyconstraint result_type t ({xmiid,name,body,...}:XMI.Constraint) =
|
|
let val result = Rep_OclTerm.Variable ("result",result_type)
|
|
val equal = ["oclLib","OclAny","="]
|
|
val body = transform_expression t body
|
|
val body_type = result_type
|
|
in
|
|
(SOME "body",Rep_OclTerm.OperationCall (result, result_type,
|
|
equal,[(body,body_type)],
|
|
Rep_OclType.Boolean))
|
|
end
|
|
handle ex => (Logger.warn ("Warning: in RepParser.transform_bodyconstraint: \
|
|
\Could not parse Constraint: "^
|
|
General.exnMessage ex^"\n"^
|
|
"using the trivial constraint 'true' instead");
|
|
(NONE, triv_expr))
|
|
|
|
fun transform_parameter t {xmiid,name,kind,type_id} =
|
|
(name, find_classifier_type t type_id
|
|
handle _ => (Logger.warn ("no type found for parameter '"^name^
|
|
"', defaulting to OclVoid");
|
|
Rep_OclType.OclVoid)
|
|
)
|
|
|
|
fun transform_operation t {xmiid,name,isQuery,parameter,visibility,
|
|
constraints,ownerScope} =
|
|
let val result_type = (
|
|
case filter (fn x => #kind x = XMI.Return) parameter
|
|
of [] => (Logger.warn ("no return type found for operation '"^name^
|
|
"', defaulting to OclVoid");
|
|
Rep_OclType.OclVoid)
|
|
| [x] => (find_classifier_type t (#type_id x)
|
|
handle _ => (Logger.warn ("return parameter for \
|
|
\operation '"^name^
|
|
"' has no declared type, \
|
|
\defaulting to OclVoid");
|
|
Rep_OclType.OclVoid))
|
|
| x::y::_ =>
|
|
let
|
|
val ret_type = find_classifier_type t (#type_id x)
|
|
handle _ => (Logger.warn ("return parameter for operation '"
|
|
^name^"' has no declared type, \
|
|
\defaulting to OclVoid");
|
|
Rep_OclType.OclVoid)
|
|
in
|
|
(Logger.warn ("operation '"^name^
|
|
"' has multiple return parameters. Using only '"^
|
|
(Rep_OclType.string_of_OclType ret_type)^"'.");
|
|
ret_type)
|
|
end)
|
|
|
|
val checked_constraints = filter_exists t constraints
|
|
in
|
|
{name=name,
|
|
arguments = (map (transform_parameter t)
|
|
(filter (fn x => #kind x <> XMI.Return) parameter)),
|
|
precondition = (map ((transform_constraint t) o (find_constraint t))
|
|
(filter_precondition t checked_constraints)),
|
|
postcondition = List.concat
|
|
[map ((transform_constraint t)o(find_constraint t))
|
|
(filter_postcondition t constraints),
|
|
map ((transform_bodyconstraint result_type t) o
|
|
(find_constraint t))
|
|
(filter_bodyconstraint t checked_constraints)],
|
|
result = result_type,
|
|
body = [],
|
|
visibility = visibility,
|
|
stereotypes = [], (* FIX *)
|
|
scope = ownerScope,
|
|
isQuery = isQuery (* FIX *)
|
|
}
|
|
end
|
|
|
|
|
|
fun transform_attribute t ({xmiid,name,type_id,changeability,visibility,ordering,
|
|
multiplicity,taggedValue,ownerScope,targetScope,stereotype,initialValue}) =
|
|
let val cls_type = find_classifier_type t type_id
|
|
handle _ => (Logger.warn ("no type found for attribute '"^name^
|
|
"', defaulting to OclVoid");
|
|
Rep_OclType.OclVoid)
|
|
in
|
|
{name = name,
|
|
attr_type = if multiplicity = [(1,1)] orelse multiplicity = [(0,1)]
|
|
then cls_type
|
|
else if ordering = XMI.Ordered then Rep_OclType.Sequence cls_type
|
|
else Rep_OclType.Set cls_type,
|
|
visibility = visibility,
|
|
scope = ownerScope,
|
|
stereotypes = map (find_stereotype t) stereotype,
|
|
init = Option.map (transform_expression t) initialValue
|
|
}
|
|
end
|
|
|
|
fun transform_aend t assocPath ({xmiid,name,association,ordering,multiplicity,
|
|
participant_id,isNavigable,aggregation,
|
|
qualifier,changeability,visibility,
|
|
targetScope}:XMI.AssociationEnd):
|
|
(Rep.associationend * (string * Rep.attribute list)) =
|
|
let
|
|
val participant = find_classifier t participant_id
|
|
val participantType = find_classifier_type t participant_id
|
|
val role = if (isSome name) then valOf name
|
|
else
|
|
let
|
|
val participantName = XMI.classifier_name_of participant
|
|
in
|
|
StringHandling.uncapitalize participantName
|
|
end
|
|
val aendPath = assocPath@[role]
|
|
|
|
in
|
|
({name = aendPath,
|
|
aend_type = participantType,
|
|
multiplicity = multiplicity,
|
|
ordered = if ordering = XMI.Ordered then true else false,
|
|
visibility = visibility,
|
|
init = NONE (* FIXME *)
|
|
}:associationend,
|
|
(role, map (transform_attribute t) qualifier)
|
|
)
|
|
end
|
|
|
|
val filter_named_aends = List.filter (fn {name=SOME _,...}:XMI.AssociationEnd => true
|
|
| _ => false)
|
|
|
|
(* FIX *)
|
|
fun transform_state t (XMI.CompositeState {xmiid,outgoing,incoming,subvertex,
|
|
isConcurrent,name,...}) =
|
|
Rep.State_CompositeState { name = name,
|
|
state_id = xmiid,
|
|
outgoing = outgoing,
|
|
incoming = incoming,
|
|
subvertex = map (transform_state t) subvertex,
|
|
isConcurrent = isConcurrent }
|
|
| transform_state t (XMI.SimpleState {xmiid,outgoing,incoming,name,...}) =
|
|
Rep.State_SimpleState { state_id = xmiid,
|
|
outgoing = outgoing,
|
|
incoming = incoming,
|
|
name = name}
|
|
| transform_state t (XMI.ActionState {xmiid,outgoing,incoming,isDynamic,
|
|
name,...}) =
|
|
Rep.SimpleState_ActionState { state_id = xmiid,
|
|
outgoing = outgoing,
|
|
incoming = incoming,
|
|
isDynamic = isDynamic,
|
|
name = name}
|
|
| transform_state t (XMI.FinalState {xmiid,incoming,...}) =
|
|
Rep.State_FinalState { state_id = xmiid,
|
|
incoming = incoming}
|
|
| transform_state t (XMI.PseudoState {xmiid,incoming,outgoing,kind,...}) =
|
|
Rep.PseudoState { state_id = xmiid,
|
|
outgoing = outgoing,
|
|
incoming = incoming,
|
|
kind = kind }
|
|
| transform_state t _ = Logger.error ("in transform_state: unsupported StateVertex type \
|
|
\(Subactivity states, object flow states and \
|
|
\sync states are not supported).")
|
|
(* a primitive hack: we take the body of the guard g as the name of an *)
|
|
(* operation to be called in order to check whether the guard is true *)
|
|
fun transform_guard t (XMI.mk_Guard g) =
|
|
let val self_type = Rep_OclType.DummyT (* FIX *)
|
|
val package_path = nil (* FIX *)
|
|
in
|
|
case #expression g of
|
|
NONE => Rep_OclTerm.OperationCall ( Rep_OclTerm.Variable ("self",self_type),
|
|
self_type,
|
|
List.concat [package_path,[Option.valOf(#body g)]],nil,
|
|
Rep_OclType.Boolean )
|
|
| SOME exp => transform_expression t exp
|
|
end
|
|
|
|
fun transform_event t (XMI.CallEvent ev) =
|
|
Rep.CallEvent (Xmi_IDTable.find_operation t (#operation ev),
|
|
map (transform_parameter t) (#parameter ev))
|
|
| transform_event t (XMI.SignalEvent ev) =
|
|
Rep.SignalEvent (map (transform_parameter t) (#parameter ev))
|
|
|
|
fun transform_proc t (XMI.mk_Procedure proc) =
|
|
{ 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) =
|
|
{top = transform_state t (#top act),
|
|
transition = map (transform_transition t) (#transitions act) }
|
|
|
|
fun transform_statemachine t (XMI.mk_StateMachine 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,
|
|
generalizations,attributes,operations,
|
|
invariant,stereotype,clientDependency,
|
|
supplierDependency,taggedValue,
|
|
classifierInState,activity_graphs,
|
|
state_machines}) =
|
|
let
|
|
val _ = Logger.debug2 ("RepParser.transform_classifier: Class\n")
|
|
val _ = Logger.debug2 ("class name: "^ name ^"\n")
|
|
val assocs = find_classifier_associations t xmiid
|
|
val _ = Logger.debug1 ("number of associations added: "^(Int.toString (List.length assocs))^"\n")
|
|
val parents = map ((find_classifier_type t) o (find_parent t))
|
|
generalizations
|
|
val filtered_parents = filter (fn x => x <> Rep_OclType.OclAny) parents
|
|
val filtered_parent = case filtered_parents
|
|
of [] => NONE
|
|
| [x] => SOME x
|
|
| x::y::_ => (Logger.warn ("Class '"^name^"' has multiple parents."^
|
|
" Using only '"^
|
|
(Rep_OclType.string_of_OclType x)^"'.");
|
|
SOME x)
|
|
val checked_invariants = filter_exists t invariant
|
|
(* val navigable_aends = filter #isNavigable (find_aends t xmiid)*)
|
|
val class_type = find_classifier_type t xmiid
|
|
val _ = Logger.info ("transform_classifier: adding "^name^"\n")
|
|
val res =
|
|
Rep.Class {name = (* type_of_classifier *) class_type,
|
|
parent = case filtered_parents
|
|
of [] => NONE
|
|
| xs => SOME ((* path_of_classifier *) (hd xs)),
|
|
attributes = map (transform_attribute t) attributes,
|
|
operations = map (transform_operation t) operations,
|
|
invariant = map ((transform_constraint t) o
|
|
(find_constraint t)) checked_invariants,
|
|
(* associationends = map (transform_aend t) navigable_aends, *)
|
|
associations = assocs,
|
|
stereotypes = map (find_stereotype t) stereotype,
|
|
interfaces = nil, (* FIX *)
|
|
visibility = visibility:Rep_Core.Visibility,
|
|
activity_graphs = List.concat [map (transform_activitygraph t) activity_graphs,
|
|
map (transform_statemachine t) state_machines],
|
|
thyname = NONE}
|
|
val _ = Logger.debug2 ("RepParser.transform_classifier\n")
|
|
in
|
|
res
|
|
end
|
|
| transform_classifier t (XMI.AssociationClass {xmiid,name,isActive,visibility,
|
|
isLeaf,generalizations,attributes,
|
|
operations,invariant,stereotype,
|
|
clientDependency,connection,
|
|
supplierDependency,taggedValue}) =
|
|
let
|
|
val _ = Logger.debug2 ("RepParser.transform_classifier: AssociationClass\n")
|
|
val _ = Logger.debug2 ("associationclass name: "^ name ^"\n")
|
|
val (_,assocs,assoc,_,_) = find_classifier_entries t xmiid
|
|
val _ = Logger.debug1 ("number of associations added: "^(Int.toString (List.length assocs))^"\n")
|
|
val _ = Logger.debug1 ("ac association found: "^(Bool.toString (assoc <> []))^"\n")
|
|
val _ = Logger.info "associations retrieved\n"
|
|
val parents = map ((find_classifier_type t) o (find_parent t))
|
|
generalizations
|
|
val _ = Logger.debug1 "parents retrieved\n"
|
|
(* FIXME: filter for classes vs. interfaces *)
|
|
val filtered_parents = filter (fn x => x <> Rep_OclType.OclAny) parents
|
|
val checked_invariants = filter_exists t invariant
|
|
(*val navigable_aends = filter #isNavigable connection *)
|
|
val class_type = find_classifier_type t xmiid
|
|
val _ = Logger.debug1 ("transform_classifier: adding "^name^"\n")
|
|
val res =
|
|
Rep.AssociationClass {name = (* type_of_classifier *)class_type,
|
|
parent = case filtered_parents
|
|
of [] => NONE
|
|
| xs => SOME ((*path_of_classifier *) (hd xs)),
|
|
attributes = map (transform_attribute t) attributes,
|
|
operations = map (transform_operation t) operations,
|
|
invariant = map ((transform_constraint t) o
|
|
(find_constraint t)) checked_invariants,
|
|
stereotypes = map (find_stereotype t) stereotype,
|
|
interfaces = nil (* FIX *),
|
|
thyname = NONE,
|
|
activity_graphs = [] (* FIXME *),
|
|
associations = assocs,
|
|
visibility = visibility,
|
|
association = assoc}
|
|
val _ = Logger.debug2 ("RepParser.transform_classifier\n")
|
|
in
|
|
res
|
|
end
|
|
| transform_classifier t (XMI.Primitive {xmiid,name,generalizations,operations,invariant,taggedValue}) =
|
|
let
|
|
val _ = Logger.debug2 ("RepParser.transform_classifier: Primitive\n")
|
|
val _ = Logger.debug2 ("primitive name: "^ name ^"\n")
|
|
val (_,assocs,_,_,_) = find_classifier_entries t xmiid
|
|
val _ = Logger.debug1 ("number of associations added: "^(Int.toString (List.length assocs))^"\n")
|
|
val checked_invariants = filter_exists t invariant
|
|
val res =
|
|
Rep.Primitive {name = (* case *) find_classifier_type t xmiid (*of Rep_OclType.Classifier x => x
|
|
| _ => raise Option*) ,
|
|
parent = NONE (* FIX *),
|
|
operations = map (transform_operation t) operations,
|
|
associations = assocs
|
|
(*associations = map (transform_aend t)
|
|
(find_aends t xmiid), *),
|
|
invariant = map ((transform_constraint t) o
|
|
(find_constraint t)) checked_invariants,
|
|
stereotypes = nil (*FIX *),
|
|
interfaces = nil (* FIX *),
|
|
thyname = NONE}
|
|
val _ = Logger.debug2 ("RepParser.transform_classifier\n")
|
|
in
|
|
res
|
|
end
|
|
| transform_classifier t (XMI.Enumeration {xmiid,name,generalizations,
|
|
operations,literals,invariant}) =
|
|
let
|
|
val _ = Logger.debug2 ("RepParser.transform_classifier: Enumeration\n")
|
|
val checked_invariants = filter_exists t invariant
|
|
val res =
|
|
Rep.Enumeration {name = (* case *) find_classifier_type t xmiid (* of Rep_OclType.Classifier x => x
|
|
| _ => raise Option *),
|
|
parent = NONE, (* FIX *)
|
|
literals = literals,
|
|
operations = map (transform_operation t) operations,
|
|
invariant = map ((transform_constraint t) o
|
|
(find_constraint t)) checked_invariants,
|
|
stereotypes = nil, (* FIX *)
|
|
interfaces = nil, (* FIX *)
|
|
thyname = NONE}
|
|
val _ = Logger.debug2 ("RepParser.transform_classifier\n")
|
|
in
|
|
res
|
|
end
|
|
| transform_classifier t (XMI.Interface { xmiid, name, generalizations, operations, invariant,
|
|
...}) =
|
|
let
|
|
val _ = Logger.debug2 ("RepParser.transform_classifier: Interface\n")
|
|
val checked_invariants = filter_exists t invariant
|
|
val res =
|
|
Rep.Interface { name = find_classifier_type t xmiid,
|
|
parents = map ((find_classifier_type t) o (find_parent t))
|
|
generalizations,
|
|
operations = map (transform_operation t) operations,
|
|
stereotypes = [], (* map (find_stereotype t) stereotype,*)
|
|
invariant = map ((transform_constraint t) o
|
|
(find_constraint t)) checked_invariants,
|
|
thyname = NONE
|
|
}
|
|
val _ = Logger.debug2 ("RepParser.transform_classifier\n")
|
|
in
|
|
res
|
|
end
|
|
| transform_classifier t (_) = Logger.error "Not supported Classifier type found."
|
|
|
|
|
|
(** transform an XMI.Association into a Rep.association *)
|
|
fun transform_association t ({xmiid,name,connection}:XMI.Association):
|
|
Rep.association =
|
|
let
|
|
val _ = Logger.debug2 ("RepParser.transform_association\n")
|
|
val _ = Logger.debug2 ("transform_association xmiid: "
|
|
^xmiid^"\n")
|
|
val associationPath = find_association_path t xmiid
|
|
val _ = Logger.info ("transform_association path: "^(string_of_path
|
|
associationPath)^
|
|
"\n")
|
|
val _ = Logger.info ("transform_association path length: "^
|
|
(Int.toString (List.length associationPath)) ^"\n")
|
|
val (associationEnds,qualifierPairs) =
|
|
ListPair.unzip (map (transform_aend t associationPath) connection)
|
|
val res =
|
|
{name = associationPath (* path_of_association *),
|
|
aends = associationEnds,
|
|
qualifiers = qualifierPairs,
|
|
aclass = NONE (* regular association *)}
|
|
val _ = Logger.debug2 ("RepParser.transform_association\n")
|
|
in
|
|
res
|
|
end
|
|
|
|
fun transformAssociationFromAssociationClass t (XMI.AssociationClass
|
|
{xmiid,connection,...}):
|
|
Rep.association =
|
|
let
|
|
val _ = Logger.debug2 ("RepParser.transformAssociationFromAassociation Class\n")
|
|
val id = xmiid^"_association"
|
|
val associationPath = find_association_path t id
|
|
val _ = Logger.debug4 ("transform_association path: "^
|
|
(string_of_path associationPath)^"\n")
|
|
val _ = Logger.debug4 ("transform_association path length: "^
|
|
(Int.toString (List.length associationPath)) ^"\n")
|
|
val (associationEnds,qualifierPairs) =
|
|
ListPair.unzip (map (transform_aend t associationPath) connection)
|
|
val aClass = SOME (path_of_OclType (find_classifier_type t xmiid))
|
|
val _ = Logger.debug2 ("RepParser.transformAssociationFromAssociationClass\n")
|
|
in
|
|
{name = associationPath (* path_of_association *),
|
|
aends = associationEnds,
|
|
qualifiers = qualifierPairs,
|
|
aclass = aClass}:Rep.association
|
|
end
|
|
|
|
(** recursively transform all classes in the package. *)
|
|
fun transform_package t (XMI.Package p) :transform_model =
|
|
let
|
|
(* we do not transform the ocl library *)
|
|
val _ = Logger.debug2 ("RepParser.transform_package\n")
|
|
val filteredPackages =
|
|
filter (fn (XMI.Package x) =>
|
|
((#name x <> "oclLib") andalso (#name x <> "UML_OCL")))
|
|
(#packages p)
|
|
val aClasses = filter (fn (XMI.AssociationClass _ ) => true
|
|
| _ => false ) (#classifiers p)
|
|
val local_associations =
|
|
map (transform_association t) (#associations p) @
|
|
(map (transformAssociationFromAssociationClass t) aClasses)
|
|
val local_classifiers = map (transform_classifier t) (#classifiers p)
|
|
val (res_classifiers,res_associations) =
|
|
ListPair.unzip (map (transform_package t) filteredPackages)
|
|
val associations = local_associations @ (List.concat res_associations)
|
|
val classifiers =local_classifiers @ (List.concat res_classifiers)
|
|
val res = (classifiers, associations )
|
|
val _ = Logger.debug2 ("RepParser.transform_package\n")
|
|
in
|
|
res
|
|
end
|
|
|
|
|
|
(** transform a UML model into a list of Rep classes.
|
|
*
|
|
* 1. traverse package hierarchy and put xmi.id of all interesting
|
|
* model elements into the hashtable
|
|
*
|
|
* 2. traverse again to find all associations, transform them into
|
|
* association ends and map the correct classes to them
|
|
* (We have to handle associations seperately because there is
|
|
* no direct link from classes to their association ends in
|
|
* the xmi file)
|
|
*
|
|
* 3. traverse again, transforming all remaining model elements,
|
|
* i.e., classes with their operations, attributes,
|
|
* constraints, etc *)
|
|
fun transformXMI_ext ({classifiers,constraints,packages,stereotypes,
|
|
variable_declarations,state_machines,
|
|
activity_graphs}):transform_model =
|
|
let
|
|
val (xmiid_table: (string,HashTableEntry) HashTable.hash_table) =
|
|
HashTable.mkTable (HashString.hashString, (op =)) (101, Option)
|
|
(* hack: insert a dummy type into the table *)
|
|
val _ = HashTable.insert xmiid_table
|
|
("DummyT",
|
|
Type (Rep_OclType.DummyT,nil,nil,
|
|
XMI.Primitive{name="DummyT",
|
|
xmiid="DummyT",
|
|
operations=[],
|
|
generalizations=[],
|
|
invariant=[],
|
|
taggedValue=[]},
|
|
nil))
|
|
(* arbitrary startnumber *)
|
|
val _ = HashTable.insert xmiid_table ("-1",UniqueName(123456))
|
|
(* for some reasons, there are model elements outside of the top-level *) (* model the xmi-file. So we have to handle them here seperately: *)
|
|
val _ = map (insert_classifier xmiid_table nil) classifiers
|
|
val _ = map (insert_constraint xmiid_table) constraints
|
|
val _ = map (insert_stereotype xmiid_table) stereotypes
|
|
val _ = map (insert_variable_dec xmiid_table) variable_declarations
|
|
(* "hd packages" is supposed to be the first model in the xmi-file *)
|
|
val model = hd packages
|
|
|
|
fun test2 (classifiers,associations) =
|
|
let
|
|
val _ = Logger.info "test2\n"
|
|
val _ = Logger.info "classifiers\n"
|
|
val _ = map (Logger.info o (fn x => x^"\n") o string_of_path o name_of)
|
|
classifiers
|
|
val _ = Logger.info "associations\n"
|
|
val _ = map (Logger.info o (fn x => x^"\n") o string_of_path o
|
|
(fn {name,aends,qualifiers,aclass} => name))
|
|
associations
|
|
val _ = Logger.info "operations\n"
|
|
fun printClassifier cls =
|
|
let
|
|
val _ = Logger.info ("output of transformXMI_ext:\n")
|
|
val _ = Logger.info ("classifier: "^ (string_of_path (name_of cls))
|
|
^"\n")
|
|
val _ = Logger.info ("associations: \n")
|
|
val _ = map (Logger.info o(fn x => x ^ "\n") o string_of_path )
|
|
(associations_of cls)
|
|
val _ = Logger.info ("operations: \n")
|
|
val _ = map (Logger.info o (fn {name,...} => name))
|
|
(operations_of cls)
|
|
in
|
|
print "\n"
|
|
end
|
|
val _ = map printClassifier classifiers
|
|
in
|
|
Logger.debug2 "\n### transformXMI_ext done\n\n";
|
|
(classifiers,associations)
|
|
end
|
|
in
|
|
insert_model xmiid_table model (* fill xmi.id table *);
|
|
fix_associations xmiid_table model (* handle associations *);
|
|
test2 (transform_package xmiid_table model) (* transform classifiers *)
|
|
end
|
|
|
|
fun transformXMI x:Classifier list = fst (transformXMI_ext x)
|
|
|
|
|
|
(**
|
|
* read and transform a .xmi file.
|
|
* @return a list of rep classifiers, or nil in case of problems
|
|
*)
|
|
|
|
fun normalize_ext ((clsses,accs):transform_model):Rep.Model =
|
|
(map (Rep.normalize accs) clsses,accs)
|
|
|
|
fun readFile f = (Logger.info ("opening "^f);
|
|
(normalize_ext o transformXMI_ext o XmiParser.readFile) f)
|
|
(* handle ex as (IllFormed msg) => raise ex *)
|
|
|
|
|
|
exception FileNotFound of string
|
|
|
|
fun importArgoUML file =
|
|
let
|
|
fun basename f = ((hd o rev) o (String.fields (fn x => x = #"/"))) f
|
|
|
|
val tmpFile = OS.FileSys.tmpName ()
|
|
val base = if String.isSuffix ".zargo" file
|
|
then String.substring(file,0, (String.size file) -6)
|
|
else file
|
|
val _ = Logger.debug1 ("*** Syscall: "^Config.unzip^" -p -ca "^base^".zargo "^(basename base)^".xmi > "^tmpFile^"\n")
|
|
val _ = OS.Process.system (Config.unzip^" -p -ca "^base^".zargo "^(basename base)^".xmi > "^tmpFile)
|
|
val model = readFile tmpFile
|
|
handle e => (OS.FileSys.remove tmpFile; raise e)
|
|
val _ = OS.FileSys.remove tmpFile
|
|
|
|
in
|
|
model
|
|
end
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(****************************************************
|
|
*****************************************************
|
|
* Test function.
|
|
*)
|
|
(* fun test (_,filename::_) = (Rep2String.printList (fst (readFile filename)); OS.Process.success) *)
|
|
(* handle ex => (printStackTrace ex; OS.Process.failure) *)
|
|
|
|
|
|
|
|
end
|
|
|
|
|