support for body expressions: convert in to "result = ..." postconditions. There might appear DummyT's, however...

git-svn-id: https://projects.brucker.ch/su4sml/svn/infsec-import/trunk/src/su4sml@3299 3260e6d1-4efc-4170-b0a7-36055960796d

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,

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)