diff --git a/src/xmi2rep.sml b/src/xmi2rep.sml index aa59747..2ebc3f0 100644 --- a/src/xmi2rep.sml +++ b/src/xmi2rep.sml @@ -100,6 +100,7 @@ fun transform_expression t (XMI.LiteralExp {symbol,expression_type}) = ) | transform_expression t _ = raise NotYetImplemented + 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)) @@ -111,24 +112,46 @@ fun transform_constraint t ({xmiid,name,body,...}:XMI.Constraint) = | ParseXMI.IllFormed msg => (print ("Warning: in Xmi2Mdr.transform_constraint: Could not parse Constraint: "^msg^"\n");(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 NotYetImplemented => (print "Warning: in Xmi2Mdr.transform_constraint: Something is not yet implemented.\n";(NONE, triv_expr)) + | IllFormed msg => (print ("Warning: in Xmi2Mdr.transform_constraint: Could not parse Constraint: "^msg^"\n");(NONE, triv_expr)) + | ParseXMI.IllFormed msg => (print ("Warning: in Xmi2Mdr.transform_constraint: Could not parse Constraint: "^msg^"\n");(NONE, triv_expr)) + fun transform_parameter t {xmiid,name,kind,type_id} = (name, find_classifier_type t type_id) fun transform_operation t {xmiid,name,isQuery,parameter,visibility, constraints,ownerScope} = - {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 constraints), - postcondition = map ((transform_constraint t) o (find_constraint t)) - (filter_postcondition t constraints), - result = find_classifier_type t ((#type_id o hd)(filter (fn x => #kind x = XMI.Return) parameter)), - visibility = visibility, - scope = ownerScope, - isQuery = isQuery (* FIX *) - } - + let val result_type = find_classifier_type t + ((#type_id o hd) (filter (fn x => #kind x = XMI.Return) + parameter)) + 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 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 constraints)], + result = result_type, + visibility = visibility, + scope = ownerScope, + isQuery = isQuery (* FIX *) + } + end fun transform_attribute t ({xmiid,name,type_id,changeability,visibility,ordering, diff --git a/src/xmi_idtable.sml b/src/xmi_idtable.sml index 759b4e5..11b545a 100644 --- a/src/xmi_idtable.sml +++ b/src/xmi_idtable.sml @@ -153,6 +153,15 @@ fun filter_postcondition t cs constr_type_name = "post" end) cs +fun filter_bodyconstraint t cs + = filter (fn x => let val constraint = find_constraint t x + val name = #name constraint + val constr_type_ref = #constraint_type constraint + val constr_type_name = find_stereotype t constr_type_ref + in + constr_type_name = "body" + end) cs + fun find_classifier t xmiid = (case valOf (HashTable.find t xmiid)