546 lines
21 KiB
Standard ML
546 lines
21 KiB
Standard ML
(*****************************************************************************
|
|
* su4sml --- an SML repository for managing (Secure)UML/OCL models
|
|
* http://projects.brucker.ch/su4sml/
|
|
*
|
|
* ocl2dresdenjava.sml ---
|
|
* This file is part of su4sml.
|
|
*
|
|
* Copyright (c) 2005-2007, ETH Zurich, Switzerland
|
|
*
|
|
* 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$ *)
|
|
|
|
(**
|
|
* A counter for the variables which returns a new number on each
|
|
* next()/nextstr() call.
|
|
*)
|
|
structure varcounter = struct
|
|
val count = ref ~1
|
|
|
|
(** Increment and return the counter value. *)
|
|
fun next() = (count := !count + 1; !count)
|
|
|
|
(** Increment and return the counter value as a string. *)
|
|
fun nextStr() = Int.toString (next())
|
|
|
|
(** Reset the counter to -1. *)
|
|
fun reset() = (count := ~1)
|
|
|
|
(** Get the current value. *)
|
|
fun current() = !count
|
|
|
|
(** Get the current value as a string. *)
|
|
fun currentStr() = Int.toString(current())
|
|
end
|
|
|
|
|
|
(**
|
|
* A map to store the relation of values calculated before the function
|
|
* call which are used in @pre terms.
|
|
*)
|
|
structure preMap =
|
|
struct
|
|
open Rep_Helper
|
|
|
|
val entries : (string * int) list ref = ref nil
|
|
|
|
(** Insert a new entry - if an entry with the same key already exists, it will be removed. *)
|
|
fun put (key : string) (value : int) = entries := (key,value)::(List.filter (fn (entry) => (fst entry) <> key) (!entries))
|
|
|
|
(** Get the entry with the given key. *)
|
|
fun get (key : string) = case (List.filter (fn (entry) => (fst entry) = key) (!entries)) of
|
|
[result] => snd result
|
|
| _ => ~1
|
|
|
|
(** Check if an entry with the given key exists. *)
|
|
fun has (key : string) = foldr (fn (a,b) => ((fst a) = key) orelse b) false (!entries)
|
|
|
|
(** Clear the list. *)
|
|
fun clear () = entries := nil
|
|
|
|
(** Get the current size of the list. *)
|
|
fun size () = List.length (!entries)
|
|
end
|
|
|
|
|
|
(**
|
|
* Conversion of OCL expressions to Java code which makes use of the
|
|
* Dresden standard ocl library.
|
|
*)
|
|
structure Ocl2DresdenJava =
|
|
struct
|
|
open Rep_Helper
|
|
open Rep_OclType
|
|
open Rep_OclTerm
|
|
open Rep_Core
|
|
open Ocl2String
|
|
|
|
(**
|
|
* Convert an oclterm to Java. 'on' should be the object which represents
|
|
* self, so in most cases it will be 'this'. The result is string * int
|
|
* where string is the generated code and int is the id of the oclNode which
|
|
* contains the result of the generated code (ie. the last node which got
|
|
* assigned a value in the generated code).
|
|
*)
|
|
fun ocl2java' oclterm on =
|
|
let
|
|
(* Get the oclNode number as a string. *)
|
|
fun count res = Int.toString(snd res)
|
|
|
|
(* Get the generated code. *)
|
|
fun code res = fst res
|
|
|
|
(* Generate a new node of type ntype which gets assigned the result of ncode. *)
|
|
fun newNode ntype ncode = "final "^ntype^" oclNode"^(varcounter.nextStr())^" = "^ncode^";\n"
|
|
|
|
(* Generate a new UmlOclFactory. *)
|
|
fun newFact () = ("final UmlOclFactory oclFact"^(varcounter.nextStr())^" = UmlOclFactory.getInstance();\n",
|
|
varcounter.current())
|
|
|
|
(* Convert a node id to oclNode<id>. *)
|
|
fun node nid = "oclNode"^(count nid)
|
|
|
|
(* Convert a node id to oclFact<id>. *)
|
|
fun fact fid = "oclFact"^(count fid)
|
|
|
|
(* Generate code for an if statement by evaluating condition and the two branches. *)
|
|
fun ifStmt cond thenb elseb rest =
|
|
let
|
|
val condition = ocl2java' cond on
|
|
val thenbranch = ocl2java' thenb on
|
|
val elsebranch = ocl2java' elseb on
|
|
in
|
|
((code condition)^
|
|
(code thenbranch)^
|
|
(code elsebranch)^
|
|
(newNode ("Ocl"^(string_of_OclType rest)) ("Ocl.toOcl"^(string_of_OclType rest)^"("^(node condition)^".ifThenElse("^(node thenbranch)^", "^(node elsebranch)^"))")),
|
|
varcounter.current())
|
|
end
|
|
|
|
(* Get an object which represents the given OclType. *)
|
|
fun typeObj ptype =
|
|
case ptype of (Classifier p) =>
|
|
let
|
|
val factory = newFact ()
|
|
val oclmodeltype = newNode "OclModelType" ((fact factory)^".getOclModelTypeFor(\""^(string_of_OclType_colon ptype)^"\")")
|
|
in
|
|
((code factory)^
|
|
oclmodeltype,
|
|
varcounter.current())
|
|
end
|
|
| (Set s) =>
|
|
let
|
|
val setType = typeObj s
|
|
in
|
|
((code setType)^
|
|
(newNode "OclCollectionType" ((node setType)^".getOclSetType()")),
|
|
varcounter.current())
|
|
end
|
|
| OclAny =>
|
|
((newNode "OclType" ("OclType.getOclAny()")),
|
|
varcounter.current())
|
|
| _ =>
|
|
(newNode "OclPrimitiveType" ("OclPrimitiveType.getOcl"^(string_of_OclType ptype)^"()"),varcounter.current())
|
|
|
|
(* Get the node id of the node which stores the result of src which was used in an @pre expression. *)
|
|
fun atPre src = ("", preMap.get(ocl2string true src))
|
|
|
|
(* Generate code for an attribute/association end call. *)
|
|
fun attrCall src path ptype =
|
|
case src of OperationCall (osrc,styp,["oclLib","OclAny","atPre"],[],_) => atPre oclterm
|
|
| _ =>
|
|
let
|
|
val target = ocl2java' src on
|
|
val typeObject = typeObj ptype
|
|
fun node' typ typobj = (newNode ("Ocl"^typ) ("Ocl.toOcl"^typ^"("^(node target)^".getFeature("^(node typobj)^", \""^(hd (rev path))^"\"))"))
|
|
in
|
|
case ptype of (Classifier p) =>
|
|
((code target)^
|
|
(code typeObject)^
|
|
(node' "ModelObject" typeObject),
|
|
varcounter.current())
|
|
| (Set s) =>
|
|
((code target)^
|
|
(code typeObject)^
|
|
(node' "Set" typeObject),
|
|
varcounter.current())
|
|
| _ =>
|
|
((code target)^
|
|
(code typeObject)^
|
|
(node' (string_of_OclType ptype) typeObject),
|
|
varcounter.current())
|
|
end
|
|
|
|
(* Access to a variable - this is either self, result or an argument to the function call. *)
|
|
fun var name t =
|
|
let
|
|
val factory = newFact ()
|
|
val vname = if name = "self" then on else name
|
|
val vtype = typeObj t
|
|
fun node' typ typobj = newNode ("Ocl"^typ) ("(Ocl"^typ^")"^(fact factory)^".getOclRepresentationFor("^(node typobj)^", "^vname^")")
|
|
in
|
|
case t of (Classifier p) =>
|
|
((code factory)^
|
|
(code vtype)^
|
|
(node' "ModelObject" vtype),
|
|
varcounter.current())
|
|
| _ =>
|
|
((code factory)^
|
|
(code vtype)^
|
|
(node' (string_of_OclType t) vtype),
|
|
varcounter.current())
|
|
end
|
|
|
|
(* Generate code for binary operations on basic types. *)
|
|
fun string_of_binop src bop arg rtype =
|
|
let
|
|
val left = ocl2java' src on
|
|
val right = ocl2java' arg on
|
|
in
|
|
((code left)^
|
|
(code right)^
|
|
(newNode ("Ocl"^(string_of_OclType rtype)) ((node left)^"."^bop^"("^(node right)^")")),
|
|
varcounter.current())
|
|
end
|
|
|
|
(* Generate code for unary operations on basic types. *)
|
|
fun string_of_unop src sop rtype =
|
|
let
|
|
val right = ocl2java' src on
|
|
in
|
|
((code right)^
|
|
(newNode ("Ocl"^(string_of_OclType rtype)) ((node right)^"."^sop^"()")),
|
|
varcounter.current())
|
|
end
|
|
|
|
(* Get an empty set. *)
|
|
fun emptySet () = (newNode "OclSet" "OclSet.getEmptyOclSet()",
|
|
varcounter.current())
|
|
|
|
(* Insert the result of src into an empty set. *)
|
|
fun oclset src =
|
|
let
|
|
val src' = ocl2java' src on
|
|
val set = emptySet ()
|
|
in
|
|
((code src')^
|
|
(code set)^
|
|
(node set)^".setToInclude("^(node src')^");\n",
|
|
varcounter.current())
|
|
end
|
|
|
|
(* Generate code for the ->notEmpty() operation. *)
|
|
fun oclnotempty src =
|
|
let
|
|
val src' = ocl2java' src on
|
|
in
|
|
((code src')^
|
|
(newNode "OclBoolean" ((node src')^".notEmpty()")),
|
|
varcounter.current())
|
|
end
|
|
|
|
(* Generate code for the ->isEmpty() operation. *)
|
|
fun oclempty src =
|
|
let
|
|
val src' = ocl2java' src on
|
|
in
|
|
((code src')^
|
|
(newNode "OclBoolean" ((node src')^".isEmpty()")),
|
|
varcounter.current())
|
|
end
|
|
|
|
(* Generate code for the ->size() operation. *)
|
|
fun oclsize src =
|
|
let
|
|
val src' = ocl2java' src on
|
|
in
|
|
((code src')^
|
|
(newNode "OclInteger" ((node src')^".size()")),
|
|
varcounter.current())
|
|
end
|
|
|
|
(* Generate code for a function call. Evaluate parameters and pass them to the call. *)
|
|
fun opCall src op_name args rtype =
|
|
let
|
|
val src' = ocl2java' src on
|
|
val resultTypeObj = typeObj rtype
|
|
(* Evaluate arguments, generate new node with the result. *)
|
|
fun evalArg (arg,atype) =
|
|
let
|
|
val acode = ocl2java' arg on
|
|
fun umltype utype = case utype of
|
|
Integer => "UmlType.INT"
|
|
| Real => "UmlType.REAL"
|
|
| String => "UmlType.STRING"
|
|
| Boolean => "UmlType.BOOLEAN"
|
|
| _ => "UmlType.MODELTYPE"
|
|
in
|
|
((code acode)^
|
|
(newNode "OclParameter" ("new OclParameter("^(umltype atype)^", "^(node acode)^")")),
|
|
varcounter.current())
|
|
end
|
|
val arguments = map evalArg args
|
|
val argcode = join "" (map fst arguments)
|
|
(* Evaluated arguments *)
|
|
val argsEvald = join ", " (map (fn a => node a) arguments)
|
|
fun node' typ typobj = argcode^(newNode ("Ocl"^typ) ("Ocl.toOcl"^typ^"("^(node src')^".getFeature("^(node typobj)^", \""^(hd (rev op_name))^"\", new OclParameter[]{"^argsEvald^"}))"))
|
|
in
|
|
case rtype of (Classifier p) =>
|
|
((code src')^
|
|
(code resultTypeObj)^
|
|
(node' "ModelObject" resultTypeObj),
|
|
varcounter.current())
|
|
| _ =>
|
|
((code src')^
|
|
(code resultTypeObj)^
|
|
(node' (string_of_OclType rtype) resultTypeObj),
|
|
varcounter.current())
|
|
end
|
|
|
|
(* Generate code for the ->oclAsType() operation. *)
|
|
fun oclAsType src oclType rtyp =
|
|
let
|
|
val src' = ocl2java' src on
|
|
val typeObject = typeObj rtyp
|
|
in
|
|
case oclType of
|
|
OclAny =>
|
|
((code src')^
|
|
(code typeObject)^
|
|
(newNode "OclAny" ("Ocl.toOclAny("^(node src')^".oclAsType("^(node typeObject)^"))")),
|
|
varcounter.current())
|
|
| _ =>
|
|
((code src')^
|
|
(code typeObject)^
|
|
(newNode "OclModelObject" ("Ocl.toOclModelObject("^(node src')^".oclAsType("^(node typeObject)^"))")),
|
|
varcounter.current())
|
|
end
|
|
|
|
(* Generate code for the ->oclIsUndefined() operation. *)
|
|
fun oclIsUndefined src =
|
|
let
|
|
val src' = ocl2java' src on
|
|
in
|
|
((code src')^
|
|
(newNode "OclBoolean" ("OclBoolean.getOclRepresentationFor("^(node src')^".isUndefined())")),
|
|
varcounter.current())
|
|
end
|
|
|
|
(* Generate code for the ->oclIsDefined() operation. *)
|
|
fun oclIsDefined src =
|
|
let
|
|
val src' = oclIsUndefined src
|
|
in
|
|
((code src')^
|
|
(newNode "OclBoolean" ((node src')^".not()")),
|
|
varcounter.current())
|
|
end
|
|
in
|
|
case oclterm of
|
|
(* Literals *)
|
|
Literal ("true",Boolean) => (newNode "OclBoolean" "OclBoolean.TRUE",varcounter.current())
|
|
| Literal ("false",Boolean) => (newNode "OclBoolean" "OclBoolean.FALSE",varcounter.current())
|
|
| Literal (l,Integer) => (newNode "OclInteger" ("new OclInteger("^l^")"),varcounter.current())
|
|
| Literal (s,String) => (newNode "OclString" ("new OclString(\""^s^"\")"),varcounter.current())
|
|
| Literal (r,Real) => (newNode "OclReal" ("new OclReal("^r^")"),varcounter.current())
|
|
(* Logical operators *)
|
|
| OperationCall (src,Boolean,["oclLib","Boolean","and"],[(arg,Boolean)],rtype) => string_of_binop src "and" arg rtype
|
|
| OperationCall (src,Boolean,["oclLib","Boolean","or"],[(arg,Boolean)],rtype) => string_of_binop src "or" arg rtype
|
|
| OperationCall (src,Boolean,["oclLib","Boolean","xor"],[(arg,Boolean)],rtype) => string_of_binop src "xor" arg rtype
|
|
| OperationCall (src,Boolean,["oclLib","Boolean","not"],[],rtype) => string_of_unop src "not" rtype
|
|
| OperationCall (src,Boolean,["oclLib","Boolean","implies"],[(arg,Boolean)],rtype) => string_of_binop src "implies" arg rtype
|
|
(* Comparison operators *)
|
|
| OperationCall (src,styp,["oclLib",classifier,"="],[(arg,atyp)],rtype) => string_of_binop src "isEqualTo" arg rtype
|
|
| OperationCall (src,styp,["oclLib",classifier,"<>"],[(arg,atyp)],rtype) => string_of_binop src "isNotEqualTo" arg rtype
|
|
| OperationCall (src,styp,["oclLib",classifier,"=="],[(arg,atyp)],rtype) => string_of_binop src "isEqualTo" arg rtype
|
|
| OperationCall (src,styp,["oclLib",classifier,"~="],[(arg,atyp)],rtype) => string_of_binop src "isNotEqualTo" arg rtype
|
|
(* OCL Real *)
|
|
| OperationCall (src,styp,["oclLib",classifier,"round"],[],rtype) => string_of_unop src "round" rtype
|
|
| OperationCall (src,styp,["oclLib",classifier,"floor"],[],rtype) => string_of_unop src "floor" rtype
|
|
| OperationCall (src,styp,["oclLib",classifier,"min"],[(arg,atyp)],rtype) => string_of_binop src "min" arg rtype
|
|
| OperationCall (src,styp,["oclLib",classifier,"max"],[(arg,atyp)],rtype) => string_of_binop src "max" arg rtype
|
|
| OperationCall (src,styp,["oclLib",classifier,"/"],[(arg,atyp)],rtype) => string_of_binop src "divide" arg rtype
|
|
| OperationCall (src,styp,["oclLib",classifier,"abs"],[],rtype) => string_of_unop src "abs" rtype
|
|
| OperationCall (src,styp,["oclLib",classifier,"-"],[(arg,atyp)],rtype) => string_of_binop src "subtract" arg rtype
|
|
| OperationCall (src,styp,["oclLib",classifier,"+"],[(arg,atyp)],rtype) => string_of_binop src "add" arg rtype
|
|
| OperationCall (src,styp,["oclLib",classifier,"*"],[(arg,atyp)],rtype) => string_of_binop src "multiply" arg rtype
|
|
(* OCL Integer *)
|
|
| OperationCall (src,styp,["oclLib",classifier,"mod"],[(arg,atyp)],rtyp) => string_of_binop src "mod" arg rtyp
|
|
| OperationCall (src,styp,["oclLib",classifier,"div"],[(arg,atyp)],rtyp) => string_of_binop src "div" arg rtyp
|
|
| OperationCall (src,styp,["oclLib",classifier,"-"],[],rtyp) => string_of_unop src "negative" rtyp
|
|
(* OCL Numerals *)
|
|
| OperationCall (src,styp,["oclLib",classifier,"<"],[(arg,atyp)],rtyp) => string_of_binop src "isLessThan" arg rtyp
|
|
| OperationCall (src,styp,["oclLib",classifier,"<="],[(arg,atyp)],rtyp) => string_of_binop src "isLessEqual" arg rtyp
|
|
| OperationCall (src,styp,["oclLib",classifier,">"],[(arg,atyp)],rtyp) => string_of_binop src "isGreaterThan" arg rtyp
|
|
| OperationCall (src,styp,["oclLib",classifier,">="],[(arg,atyp)],rtyp) => string_of_binop src "isGreaterEqual" arg rtyp
|
|
(* Some collection operations *)
|
|
| OperationCall (src,styp,["oclLib",_,"asSet"],[],rtyp) => oclset src
|
|
| OperationCall (src,styp,["oclLib",_,"notEmpty"],[],rtyp) => oclnotempty src
|
|
| OperationCall (src,styp,["oclLib",_,"isEmpty"],[],rtyp) => oclempty src
|
|
| OperationCall (src,styp,["oclLib",_,"size"],[],rtyp) => oclsize src
|
|
(* oclIs(Und|D)efined *)
|
|
| OperationCall (src,styp,["oclIsDefined"],[],rtyp) => oclIsDefined src
|
|
| OperationCall (src,styp,["oclIsUndefined"],[],rtyp) => oclIsUndefined src
|
|
(* @pre *)
|
|
| OperationCall (src,styp,["oclLib","OclAny","atPre"],[],_) => atPre src
|
|
(* Unsupported call - TODO: maybe replace by error "..."? *)
|
|
| OperationCall (src,styp,[opname],[],rtyp) => (("/* Unsupported OCL operation "^opname^". */\n"),varcounter.current())
|
|
(* If *)
|
|
| If (cond,condt,thenb,thent,elseb,elset,rest) => ifStmt cond thenb elseb rest
|
|
(* Access to attributes *)
|
|
| AttributeCall (src,stype,path,ptype) => attrCall src path ptype
|
|
(* Access association ends *)
|
|
| AssociationEndCall (src,stype,path,ptype) => attrCall src path ptype
|
|
(* Access to variables *)
|
|
| Variable (name, t) => var name t
|
|
(* Function calls *)
|
|
| OperationCall (src,styp,op_name,args,rtype) => opCall src op_name args rtype
|
|
(* oclAsType *)
|
|
| OperationWithType (src,styp,"oclAsType",oclType,rtyp) => oclAsType src oclType rtyp
|
|
(* Print currently unknown stuff using ocl2string. TODO: maybe replace by error "..."? *)
|
|
| _ => ("/* "^(ocl2string true oclterm)^" */\n", 0)
|
|
end
|
|
|
|
(** Return the Java code which evaluates the oclterm. *)
|
|
fun ocl2java oclterm on = fst (ocl2java' oclterm on)
|
|
|
|
(** Convert list of arguments ((string * Rep_OclType.OclType) list) to a comma separated string. *)
|
|
fun opargs2string args =
|
|
let
|
|
fun arg2string (name,typ) = (Rep_OclType.string_of_OclType typ)^" "^name
|
|
in
|
|
join ", " (List.map arg2string args )
|
|
end
|
|
|
|
(** Return ocl formula as a Java comment. *)
|
|
fun oclComment formula = "/* "^(ocl2string false formula)^" */\n"
|
|
|
|
(** Check the result of checking a condition. *)
|
|
fun checkConditionResult condition name condType ex uut =
|
|
let
|
|
val name' = case name of SOME t => " "^t
|
|
| NONE => ""
|
|
in
|
|
(fst condition)^
|
|
"if(!oclNode"^(Int.toString(snd condition))^".isTrue()){"^
|
|
"\n\tthrow new "^ex^"(\""^condType^name'^" of "^uut^" failed!\");\n"^
|
|
"}\n"
|
|
end
|
|
|
|
(** Extract @pre operations from the postconditions, generate code to save @pre values. *)
|
|
fun preExtract env on curOp =
|
|
let
|
|
fun getPres precond =
|
|
let
|
|
(* Save the result of attribute/association end calls. *)
|
|
fun attSave src stype path ptype call = case src of OperationCall (asrc,styp,["oclLib","OclAny","atPre"],[],_) =>
|
|
let
|
|
val condstr = ocl2string true precond
|
|
in
|
|
if not (preMap.has(condstr)) then
|
|
let
|
|
val code = ocl2java' (call (asrc,stype,path,ptype)) on
|
|
in
|
|
((preMap.put condstr (snd code));
|
|
(fst code))
|
|
end
|
|
else
|
|
""
|
|
end
|
|
| _ => getPres src
|
|
(* Save the result of function calls. *)
|
|
fun resSave src styp op_name args rtype = case src of OperationCall (asrc,styp,["oclLib","OclAny","atPre"],[],_) =>
|
|
let
|
|
val condstr = ocl2string true asrc
|
|
in
|
|
if not (preMap.has(condstr)) then
|
|
let
|
|
val code = ocl2java' asrc on
|
|
in
|
|
((preMap.put condstr (snd code));
|
|
(fst code))
|
|
end
|
|
else
|
|
""
|
|
end
|
|
| _ => (getPres src)^(join "\n" (map (getPres o fst) args))
|
|
in
|
|
case precond of
|
|
OperationCall (src,styp,["oclLib","OclAny","atPre"],[],_) => Logger.error "atPre()-operation should not be reached."
|
|
| OperationCall (src,styp,op_name,args,rtype) => resSave src styp op_name args rtype
|
|
| Literal (_,_) => ""
|
|
| If (cond,_,thenb,_,elseb,_,_) => (getPres cond)^(getPres thenb)^(getPres elseb)
|
|
| AttributeCall (src,stype,path,ptype) => attSave src stype path ptype AttributeCall
|
|
| AssociationEndCall (src,stype,path,ptype) => attSave src stype path ptype AssociationEndCall
|
|
| Variable (_,_) => ""
|
|
| OperationWithType (src,_,_,_,_) => getPres src
|
|
| _ => ""
|
|
end
|
|
in
|
|
join "\n" (List.map (getPres o snd) (Rep_Core.postcondition_of_op curOp))
|
|
end
|
|
|
|
(** Create the string which checks preconditions. *)
|
|
fun precondString env on curOp ex =
|
|
let
|
|
fun getPrecond precond =
|
|
(oclComment (snd precond))^
|
|
(checkConditionResult (ocl2java' (snd precond) on) (fst precond) "Precondition" ex ((Rep_Core.name_of_op curOp)^"("^(opargs2string (Rep_Core.arguments_of_op curOp))^")"))
|
|
in
|
|
(preMap.clear();
|
|
(join "\n" (List.map getPrecond (Rep_Core.precondition_of_op curOp)))^
|
|
("\n/* Save values used in @pre-expressions of the postcondition */\n"^
|
|
(preExtract env on curOp)))
|
|
end
|
|
|
|
(** Create the string which checks postconditions. *)
|
|
fun postcondString env on curOp ex =
|
|
let
|
|
fun getPostcond postcond =
|
|
(oclComment (snd postcond))^
|
|
(checkConditionResult (ocl2java' (snd postcond) on) (fst postcond) "Postcondition" ex ((Rep_Core.name_of_op curOp)^"("^(opargs2string (Rep_Core.arguments_of_op curOp))^")"))
|
|
in
|
|
join "\n" (List.map getPostcond (Rep_Core.postcondition_of_op curOp))
|
|
end
|
|
|
|
(** Create the string which checks invariants. *)
|
|
fun invString env on curCl ex =
|
|
let
|
|
fun getInvariant invariant =
|
|
(oclComment (snd invariant))^
|
|
(checkConditionResult (ocl2java' (snd invariant) on) (fst invariant) "Invariant" ex (Rep_Core.short_name_of curCl))
|
|
in
|
|
join "\n" (List.map getInvariant (Rep_Core.invariant_of curCl))
|
|
end
|
|
|
|
end
|