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
This commit is contained in:
parent
b636c52e76
commit
0af74bb770
|
@ -100,6 +100,7 @@ fun transform_expression t (XMI.LiteralExp {symbol,expression_type}) =
|
||||||
)
|
)
|
||||||
| transform_expression t _ = raise NotYetImplemented
|
| transform_expression t _ = raise NotYetImplemented
|
||||||
|
|
||||||
|
|
||||||
fun transform_constraint t ({xmiid,name,body,...}:XMI.Constraint) =
|
fun transform_constraint t ({xmiid,name,body,...}:XMI.Constraint) =
|
||||||
let val n_name = case name of
|
let val n_name = case name of
|
||||||
(SOME s) => if (s = "") then NONE else (SOME(s))
|
(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))
|
| ParseXMI.IllFormed msg => (print ("Warning: in Xmi2Mdr.transform_constraint: Could not parse Constraint: "^msg^"\n");(NONE, triv_expr))
|
||||||
end
|
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} =
|
fun transform_parameter t {xmiid,name,kind,type_id} =
|
||||||
(name, find_classifier_type t type_id)
|
(name, find_classifier_type t type_id)
|
||||||
|
|
||||||
fun transform_operation t {xmiid,name,isQuery,parameter,visibility,
|
fun transform_operation t {xmiid,name,isQuery,parameter,visibility,
|
||||||
constraints,ownerScope} =
|
constraints,ownerScope} =
|
||||||
|
let val result_type = find_classifier_type t
|
||||||
|
((#type_id o hd) (filter (fn x => #kind x = XMI.Return)
|
||||||
|
parameter))
|
||||||
|
in
|
||||||
{name=name,
|
{name=name,
|
||||||
arguments = map (transform_parameter t)
|
arguments = (map (transform_parameter t)
|
||||||
(filter (fn x => #kind x <> XMI.Return) parameter),
|
(filter (fn x => #kind x <> XMI.Return) parameter)),
|
||||||
precondition = map ((transform_constraint t) o (find_constraint t))
|
precondition = (map ((transform_constraint t) o (find_constraint t))
|
||||||
(filter_precondition t constraints),
|
(filter_precondition t constraints)),
|
||||||
postcondition = map ((transform_constraint t) o (find_constraint t))
|
postcondition = List.concat [map ((transform_constraint t) o
|
||||||
|
(find_constraint t))
|
||||||
(filter_postcondition t constraints),
|
(filter_postcondition t constraints),
|
||||||
result = find_classifier_type t ((#type_id o hd)(filter (fn x => #kind x = XMI.Return) parameter)),
|
map ((transform_bodyconstraint result_type t) o
|
||||||
|
(find_constraint t))
|
||||||
|
(filter_bodyconstraint t constraints)],
|
||||||
|
result = result_type,
|
||||||
visibility = visibility,
|
visibility = visibility,
|
||||||
scope = ownerScope,
|
scope = ownerScope,
|
||||||
isQuery = isQuery (* FIX *)
|
isQuery = isQuery (* FIX *)
|
||||||
}
|
}
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
fun transform_attribute t ({xmiid,name,type_id,changeability,visibility,ordering,
|
fun transform_attribute t ({xmiid,name,type_id,changeability,visibility,ordering,
|
||||||
|
|
|
@ -153,6 +153,15 @@ fun filter_postcondition t cs
|
||||||
constr_type_name = "post"
|
constr_type_name = "post"
|
||||||
end) cs
|
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 =
|
fun find_classifier t xmiid =
|
||||||
(case valOf (HashTable.find t xmiid)
|
(case valOf (HashTable.find t xmiid)
|
||||||
|
|
Loading…
Reference in New Issue