2007-06-12 18:51:39 +00:00
|
|
|
(*****************************************************************************
|
2016-10-23 23:35:11 +00:00
|
|
|
* su4sml --- an SML repository for managing (Secure)UML/OCL models
|
2007-07-04 06:41:30 +00:00
|
|
|
* http://projects.brucker.ch/su4sml/
|
2007-06-12 18:51:39 +00:00
|
|
|
*
|
2007-07-04 06:41:30 +00:00
|
|
|
* context_declarations.sml ---
|
|
|
|
* This file is part of su4sml.
|
2007-06-12 18:51:39 +00:00
|
|
|
*
|
2008-12-30 09:00:24 +00:00
|
|
|
* Copyright (c) 2005-2007 ETH Zurich, Switzerland
|
2009-01-04 14:45:30 +00:00
|
|
|
* 2008-2009 Achim D. Brucker, Germany
|
2007-07-04 06:41:30 +00:00
|
|
|
*
|
|
|
|
* 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$ *)
|
|
|
|
|
2007-06-12 18:51:39 +00:00
|
|
|
signature CONTEXT =
|
|
|
|
sig
|
|
|
|
|
|
|
|
(* datatypes *)
|
2008-12-30 09:00:24 +00:00
|
|
|
datatype ConditionType = pre | post | body (* | def *)
|
2007-06-12 18:51:39 +00:00
|
|
|
datatype AttrOrAssoc = derive | init | def
|
|
|
|
datatype context =
|
|
|
|
Empty_context of string *
|
|
|
|
Rep_OclTerm.OclTerm (* expression *)
|
|
|
|
| Inv of string list * (* context *)
|
|
|
|
string option * (* name of invariant *)
|
|
|
|
Rep_OclTerm.OclTerm (* invariant expression *)
|
|
|
|
| Attr of string list * (* context *)
|
|
|
|
Rep_OclType.OclType * (* type *)
|
|
|
|
AttrOrAssoc * (* {Init|Derive} *)
|
|
|
|
Rep_OclTerm.OclTerm (* init_or_der_value *)
|
|
|
|
| Cond of string list * (* context *)
|
|
|
|
string * (* name of operation *)
|
|
|
|
(string * Rep_OclType.OclType) list * (* signature of operation *)
|
|
|
|
Rep_OclType.OclType * (* result *)
|
|
|
|
ConditionType * (* {Pre | Post | Body} *)
|
|
|
|
string option * (* name of precondition *)
|
2008-03-26 20:14:40 +00:00
|
|
|
Rep_OclTerm.OclTerm (* condition expression *)
|
2007-06-12 18:51:39 +00:00
|
|
|
| Guard of string list * (* context *) (* not yet supported *)
|
|
|
|
string option * (* name *)
|
|
|
|
Rep_OclTerm.OclTerm (* expression *)
|
|
|
|
|
|
|
|
(* exceptions *)
|
|
|
|
exception Error of string
|
|
|
|
exception wrongOperation of string
|
|
|
|
|
|
|
|
(* operations *)
|
|
|
|
val add_source : Rep_OclTerm.OclTerm * Rep_OclTerm.OclTerm -> Rep_OclTerm.OclTerm
|
|
|
|
val nest_source : Rep_OclTerm.OclTerm list -> Rep_OclTerm.OclTerm
|
|
|
|
val cond_type_to_string : ConditionType -> string
|
|
|
|
val package_of_context : context -> string list
|
|
|
|
val real_path : string list -> string list
|
|
|
|
val gen_let_term : (string * Rep_OclType.OclType * Rep_OclTerm.OclTerm) list -> Rep_OclTerm.OclTerm -> Rep_OclTerm.OclTerm
|
|
|
|
val gen_literal_term : string * Rep_OclType.OclType -> Rep_OclTerm.OclTerm * Rep_OclType.OclType
|
|
|
|
val extend_path : context -> string list -> context
|
|
|
|
val list_extend_path : string list -> context list -> context list
|
|
|
|
val real_signature : ('a * 'b) list -> ('a * 'b) list
|
|
|
|
val cxt_list2string : context list -> string
|
|
|
|
val guard_list : string list * (string option * Rep_OclTerm.OclTerm) list -> context list
|
|
|
|
val inv_list : string list * (string option * Rep_OclTerm.OclTerm) list -> context list
|
|
|
|
val cond_list : string list * (string * Rep_OclType.OclType) list * (ConditionType * string option * Rep_OclTerm.OclTerm) list -> context list
|
|
|
|
val attr_list : string list * Rep_OclType.OclType * (AttrOrAssoc * Rep_OclTerm.OclTerm) list -> context list
|
|
|
|
|
|
|
|
(* values *)
|
|
|
|
val OclLibPackage : string
|
2008-04-03 12:26:02 +00:00
|
|
|
|
|
|
|
(* OclConsoleParser *)
|
|
|
|
val rename_classifier : Rep_OclType.Path -> Rep_Core.Classifier -> Rep_Core.Classifier
|
|
|
|
val merge_classifiers : Rep_Core.Classifier list -> Rep_Core.Classifier
|
|
|
|
|
|
|
|
val operations_to_classifier : Rep_Core.operation list -> Rep_Core.Classifier
|
|
|
|
val attributes_to_classifier : Rep_Core.attribute list -> Rep_Core.Classifier
|
|
|
|
val constraints_to_classifier : ((string option * Rep_OclTerm.OclTerm) list) -> Rep_Core.Classifier
|
|
|
|
|
|
|
|
val dispatch_pre_or_post : ConditionType -> ((ConditionType * string option * Rep_OclTerm.OclTerm) list) -> (string option * Rep_OclTerm.OclTerm) list
|
|
|
|
|
|
|
|
|
2007-06-12 18:51:39 +00:00
|
|
|
end
|
|
|
|
structure Context:CONTEXT =
|
|
|
|
struct
|
|
|
|
|
2008-03-27 18:56:12 +00:00
|
|
|
|
2007-06-12 18:51:39 +00:00
|
|
|
open Rep_Core
|
|
|
|
open Rep_OclType
|
|
|
|
open Rep_OclTerm
|
2008-04-03 12:26:02 +00:00
|
|
|
open XMI_DataTypes
|
2007-06-12 18:51:39 +00:00
|
|
|
open OclLibrary
|
2008-03-17 13:53:09 +00:00
|
|
|
|
2007-06-12 18:51:39 +00:00
|
|
|
|
|
|
|
type operation = Rep_Core.operation
|
2008-04-03 12:26:02 +00:00
|
|
|
|
|
|
|
type Visibility = Rep_Core.Visibility
|
|
|
|
type Scope = XMI_DataTypes.ScopeKind
|
2007-06-12 18:51:39 +00:00
|
|
|
|
|
|
|
datatype ConditionType = pre | post | body
|
|
|
|
|
|
|
|
datatype AttrOrAssoc = derive | init | def
|
|
|
|
|
|
|
|
datatype context =
|
|
|
|
Empty_context of string *
|
|
|
|
Rep_OclTerm.OclTerm (* expression *)
|
|
|
|
| Inv of string list * (* context *)
|
|
|
|
string option * (* name of invariant *)
|
|
|
|
Rep_OclTerm.OclTerm (* invariant expression *)
|
|
|
|
| Attr of string list * (* context *)
|
|
|
|
Rep_OclType.OclType * (* type *)
|
|
|
|
AttrOrAssoc * (* {Init|Derive} *)
|
|
|
|
Rep_OclTerm.OclTerm (* init_or_der_value *)
|
|
|
|
| Cond of string list * (* context *)
|
|
|
|
string * (* name of operation *)
|
|
|
|
(string * Rep_OclType.OclType) list * (* signature of operation *)
|
|
|
|
Rep_OclType.OclType * (* result *)
|
|
|
|
ConditionType * (* {Pre | Post | Body} *)
|
|
|
|
string option * (* name of precondition *)
|
|
|
|
Rep_OclTerm.OclTerm (* preondition expression *)
|
|
|
|
| Guard of string list * (* context *) (* not yet supported *)
|
|
|
|
string option * (* name *)
|
|
|
|
Rep_OclTerm.OclTerm (* expression *)
|
|
|
|
|
|
|
|
|
|
|
|
exception Error of string
|
|
|
|
exception wrongOperation of string
|
|
|
|
exception NestSourceError of string
|
|
|
|
|
|
|
|
|
|
|
|
val OclLibPackage = OclLibrary.OclLibPackage
|
|
|
|
|
|
|
|
|
|
|
|
(* RETURN: string *)
|
|
|
|
fun cond_type_to_string pre = "pre"
|
|
|
|
| cond_type_to_string post = "post"
|
|
|
|
| cond_type_to_string body = "body"
|
|
|
|
|
|
|
|
(* RETURN: string list *)
|
|
|
|
fun package_of_context (Empty_context (_,_)) = raise Error "Empty Context in Context.package_of"
|
|
|
|
| package_of_context (Inv (p,_,_)) = rev (tl (rev p))
|
|
|
|
| package_of_context (Attr (p,_,_,_)) = rev ((tl o tl) (rev p))
|
|
|
|
| package_of_context (Cond (p,_,_,_,_,_,_)) = rev ((tl o tl) (rev p))
|
|
|
|
| package_of_context (Guard (_,_,_)) = raise Error "Guard not supported in in Context.package_of"
|
|
|
|
|
|
|
|
|
|
|
|
(* switch arguments *)
|
|
|
|
fun switch f (a,b) = f (b,a)
|
|
|
|
|
|
|
|
(* RETURN: Path *)
|
|
|
|
fun real_path ([]) = []
|
|
|
|
| real_path ([x]) = []
|
|
|
|
| real_path (x::tail) = x::real_path tail
|
|
|
|
|
|
|
|
(* RETURN: OclTerm /* a let term */ *)
|
|
|
|
fun gen_let_term [] expr = expr
|
|
|
|
| gen_let_term ((str,typ,exp)::init_var_list_tail) expr =
|
|
|
|
(Let (str,typ,exp,DummyT,gen_let_term init_var_list_tail expr,DummyT))
|
|
|
|
|
|
|
|
(* RETURN: OclTerm *)
|
|
|
|
fun gen_literal_term (name,typ) = (Literal (name,typ),typ)
|
|
|
|
|
|
|
|
(* prefix the path of an OclTerm with 'ext_path' *)
|
|
|
|
fun extend_path (Attr (path,typ,selector,expr)) ext_path = Attr (ext_path@path,prefix_type ext_path typ,selector,prefix_expression ext_path expr)
|
|
|
|
| extend_path (Cond (path,name,sign,res,selector,name_sel,expr)) ext_path =
|
|
|
|
Cond (ext_path@path,name,sign,res,selector,name_sel,prefix_expression ext_path expr)
|
|
|
|
| extend_path (Inv (path, name, expr)) ext_path = Inv (ext_path@path,name,prefix_expression ext_path expr)
|
|
|
|
| extend_path (Guard (path, name, expr)) ext_path = Guard (ext_path@path, name, prefix_expression ext_path expr)
|
|
|
|
|
|
|
|
|
|
|
|
(* RETURN: context list *)
|
|
|
|
(* prefixes the path of every list member with 'ext_path' *)
|
|
|
|
fun list_extend_path s [] = []
|
|
|
|
| list_extend_path ext_path ((Empty_context (s,t))::(context_list_tail)) =
|
|
|
|
[(Empty_context(s,t))]@(list_extend_path ext_path context_list_tail)
|
|
|
|
|
|
|
|
| list_extend_path ext_path ((Inv(path,st,t))::(context_list_tail)) =
|
|
|
|
[(extend_path (Inv(path,st,t)) ext_path)]@(list_extend_path ext_path context_list_tail)
|
|
|
|
|
|
|
|
| list_extend_path ext_path ((Attr(path,ty,aoa,t))::(context_list_tail)) =
|
|
|
|
[(extend_path (Attr(path,ty,aoa,t)) ext_path)]@(list_extend_path ext_path context_list_tail)
|
|
|
|
|
|
|
|
| list_extend_path ext_path ((Cond(path,s,sig_list,res,con,so,t))::(context_list_tail)) =
|
|
|
|
[(extend_path (Cond(path,s,sig_list,res,con,so,t)) ext_path)]@(list_extend_path ext_path context_list_tail)
|
|
|
|
| list_extend_path ext_path ((Guard(path,so,t))::(context_list_tail)) =
|
|
|
|
[(extend_path (Guard(path,so,t)) ext_path)]@(list_extend_path ext_path context_list_tail)
|
|
|
|
|
|
|
|
(* deletes last element of signature which is return type of operation *)
|
|
|
|
fun real_signature ([]) = []
|
|
|
|
| real_signature [(name,typ)] = []
|
|
|
|
| real_signature ((name,typ)::tail) =
|
|
|
|
(name,typ)::real_signature tail
|
|
|
|
|
|
|
|
(* RETURN: OclTerm *)
|
|
|
|
(* Add to an OclTerm the correct source term 'source' *)
|
|
|
|
fun add_source (source,(AttributeCall (_, _, path, res_typ ))) =
|
|
|
|
let
|
|
|
|
val test = (AttributeCall (source,DummyT,path,res_typ))
|
2009-01-03 21:18:36 +00:00
|
|
|
val _ = Logger.debug4 ("source added for AttributeCall..." ^ Ocl2String.ocl2string true test ^ "\n");
|
2007-06-12 18:51:39 +00:00
|
|
|
in
|
|
|
|
(AttributeCall (source, DummyT, path, res_typ))
|
|
|
|
end
|
|
|
|
| add_source (source,(OperationCall (_,_,path,paras,res_typ))) =
|
|
|
|
let
|
2009-01-03 21:18:36 +00:00
|
|
|
val _ = Logger.debug1 ("source added for OperationCall..." ^ "\n");
|
2007-06-12 18:51:39 +00:00
|
|
|
in
|
|
|
|
(OperationCall (source,DummyT,path,paras,res_typ))
|
|
|
|
end
|
|
|
|
| add_source (source, Literal(s,t)) = Literal (s,t)
|
|
|
|
| add_source (source, CollectionLiteral (part_list,typ)) =
|
|
|
|
let
|
2009-01-03 21:18:36 +00:00
|
|
|
val _ = Logger.debug1 ("source added for AttributeCall..." ^ "\n");
|
2007-06-12 18:51:39 +00:00
|
|
|
in
|
|
|
|
(CollectionLiteral (part_list,typ))
|
|
|
|
end
|
|
|
|
| add_source (source, Iterator(name,iter_vars_list,_,_,body_term,body_typ,res_typ)) =
|
|
|
|
let
|
2009-01-03 21:18:36 +00:00
|
|
|
val _ = Logger.debug1 ("source added for Iterator..." ^ "\n");
|
2007-06-12 18:51:39 +00:00
|
|
|
in
|
|
|
|
(Iterator (name,iter_vars_list,source,DummyT,body_term,body_typ,res_typ))
|
|
|
|
end
|
|
|
|
| add_source (source, Let(paras)) =
|
|
|
|
(* let has no source *)
|
|
|
|
Let(paras)
|
|
|
|
| add_source (source, If (paras)) =
|
|
|
|
(* If has no source *)
|
|
|
|
If (paras)
|
2007-07-30 08:43:40 +00:00
|
|
|
| add_source (source, Iterate([],acc_var_name,acc_var_type,acc_var_term,sterm,stype,bterm,btype,res_type)) =
|
|
|
|
let
|
2009-01-03 21:18:36 +00:00
|
|
|
val _ = Logger.debug1 ("source added for Iterate ..." ^ "\n");
|
2007-07-30 08:43:40 +00:00
|
|
|
in
|
|
|
|
(Iterate ([],acc_var_name,acc_var_type,acc_var_term,source,DummyT,bterm,btype,res_type))
|
|
|
|
end
|
|
|
|
| add_source (source, Iterate(iter_vars,acc_var_name,acc_var_type,acc_var_term,sterm,stype,bterm,btype,res_type)) =
|
|
|
|
let
|
2009-01-03 21:18:36 +00:00
|
|
|
val _ = Logger.debug1 ("source added for Iterate ..." ^ "\n");
|
2007-07-30 08:43:40 +00:00
|
|
|
in
|
|
|
|
(Iterate (iter_vars,acc_var_name,acc_var_type,acc_var_term,source,DummyT,bterm,btype,res_type))
|
|
|
|
end
|
2007-06-12 18:51:39 +00:00
|
|
|
|
|
|
|
(* RETURN: OclTerm list *)
|
|
|
|
fun add_source_to_list source (h::tail) = (add_source (source,h))::tail
|
|
|
|
|
|
|
|
(* RETURN: OclTerm *)
|
|
|
|
(* add sources of a list, when every list element is the
|
|
|
|
source of the following element.
|
|
|
|
The last element is initalized with "self", because its
|
|
|
|
always so in an object oriented language if its no an argument
|
|
|
|
of an operation, which is checked later.
|
|
|
|
*)
|
|
|
|
|
|
|
|
(* RETURN: OclTerm *)
|
|
|
|
fun nest_source (OperationCall (sterm,styp,[OclLibPackage,rtyp,"-"],[],res_typ)::tail) =
|
|
|
|
let
|
2009-01-03 21:18:36 +00:00
|
|
|
val _ = Logger.debug1 ("unary_exp_cs Call: '-' ... \n")
|
2007-06-12 18:51:39 +00:00
|
|
|
in
|
|
|
|
foldl (switch add_source) (OperationCall (sterm,styp,[OclLibPackage,rtyp,"-"],[],res_typ)) tail
|
|
|
|
end
|
|
|
|
| nest_source (OperationCall (sterm,styp,[OclLibPackage,rtyp,"not"],[],res_typ)::tail) =
|
|
|
|
let
|
2009-01-03 21:18:36 +00:00
|
|
|
val _ = Logger.debug1 ("unary_exp_cs Call: 'not' ... \n")
|
2007-06-12 18:51:39 +00:00
|
|
|
in
|
|
|
|
foldl (switch add_source) (OperationCall (sterm,styp,[OclLibPackage,rtyp,"not"],[],res_typ)) tail
|
|
|
|
end
|
|
|
|
| nest_source term_list =
|
|
|
|
let
|
2009-01-03 21:18:36 +00:00
|
|
|
val _ = Logger.debug1 ("source nested for AttributeCall..." ^ "\n");
|
|
|
|
val _ = Logger.debug1 ((Ocl2String.ocl2string true (List.last term_list)) ^ "bla\n");
|
2007-06-12 18:51:39 +00:00
|
|
|
in
|
|
|
|
foldl (switch add_source) (Variable ("dummy_source",DummyT)) term_list
|
|
|
|
end
|
|
|
|
|
|
|
|
(* RETURN: context list *)
|
|
|
|
fun attr_list (context,Typ,[]) =
|
|
|
|
let
|
2009-01-03 21:18:36 +00:00
|
|
|
val _ = Logger.debug1 ("Contextes created form list of Attributes ..." ^ "\n")
|
2007-06-12 18:51:39 +00:00
|
|
|
in
|
|
|
|
[]
|
|
|
|
end
|
|
|
|
| attr_list (context,Typ,((asser,expr)::tail)) =
|
|
|
|
let
|
2009-01-03 21:18:36 +00:00
|
|
|
val _ = Logger.debug1 ("Contextes created form list of Attributes ..." ^ "\n")
|
2007-06-12 18:51:39 +00:00
|
|
|
in
|
|
|
|
(Attr (context,Typ,asser,expr))::(attr_list (context,Typ,tail))
|
|
|
|
end
|
|
|
|
|
|
|
|
(* RETURN: context list *)
|
|
|
|
fun inv_list (context,[]) =
|
|
|
|
let
|
2009-01-03 21:18:36 +00:00
|
|
|
val _ = Logger.debug4 ("Contextes created form list of invs ..." ^ "\n")
|
2007-06-12 18:51:39 +00:00
|
|
|
in
|
|
|
|
[]
|
|
|
|
end
|
|
|
|
| inv_list (context,((name,expr)::tail)) =
|
|
|
|
let
|
2009-01-03 21:18:36 +00:00
|
|
|
val _ = Logger.debug4 ("Contextes created form list of invs ..." ^ "\n")
|
2007-06-12 18:51:39 +00:00
|
|
|
in
|
|
|
|
(Inv(context,name,expr))::(inv_list (context,tail))
|
|
|
|
end
|
|
|
|
|
|
|
|
(* RETURN: context list *)
|
|
|
|
fun cond_list (path,sign,[]) =
|
|
|
|
let
|
2009-01-03 21:18:36 +00:00
|
|
|
val _ = Logger.debug4 ("Contextes created form list of conds ..." ^ "\n")
|
2007-06-12 18:51:39 +00:00
|
|
|
in
|
|
|
|
[]
|
|
|
|
end
|
|
|
|
| cond_list (path,sign,((asser,name_cond,expr)::tail)) =
|
|
|
|
let
|
2009-01-03 21:18:36 +00:00
|
|
|
val _ = Logger.debug4 ("Contextes created form list of conds ..." ^ "\n")
|
2007-06-12 18:51:39 +00:00
|
|
|
in
|
|
|
|
Cond(real_path path,List.last path,real_signature sign, #2(List.last sign),asser,name_cond,expr)::cond_list (path,sign,tail)
|
|
|
|
end
|
|
|
|
|
|
|
|
(* RETURN: context list *)
|
|
|
|
fun guard_list (context,[]) = []
|
|
|
|
| guard_list (context,(name,expr)::tail) = Guard (context,name,expr)::guard_list (context,tail)
|
|
|
|
|
2009-01-04 14:45:30 +00:00
|
|
|
|
|
|
|
|
|
|
|
|
2007-06-12 18:51:39 +00:00
|
|
|
(* RETURN: string *)
|
2009-01-04 14:45:30 +00:00
|
|
|
(*
|
|
|
|
fun cxt_list2string ([]) = ""
|
|
|
|
| cxt_list2string ((Empty_context(s,t))::tail) =
|
|
|
|
"empty: "^(Ocl2String.ocl2string false t)^"\n"^(cxt_list2string tail)
|
|
|
|
| cxt_list2string ((Inv(p,s,t))::tail) =
|
|
|
|
"inv: "^(Ocl2String.ocl2string false t)^"\n"^(cxt_list2string tail)
|
|
|
|
| cxt_list2string ((Attr(p,ty,a,t))::tail) =
|
|
|
|
"attr_or_assoc "^(Ocl2String.ocl2string false t)^"\n"^(cxt_list2string tail)
|
|
|
|
| cxt_list2string ((Cond(p,s,l,ty,c,so,t))::tail) =
|
|
|
|
"condition: "^(Ocl2String.ocl2string false t)^"\n"^(cxt_list2string tail)
|
|
|
|
| cxt_list2string ((Guard(p,so,t))::tail) =
|
|
|
|
"guard: "^(Ocl2String.ocl2string false t)^"\n"^(cxt_list2string tail)
|
|
|
|
*)
|
|
|
|
|
|
|
|
fun string_of_arglist [] = ""
|
|
|
|
| string_of_arglist [(n,t)] = n^":"^(Rep_OclType.string_of_OclType t)
|
|
|
|
| string_of_arglist (x::xs) = (string_of_arglist [x])^", "^(string_of_arglist xs)
|
|
|
|
|
|
|
|
fun cxt2string (Empty_context(s,t)) = s^"\n"
|
|
|
|
^" empty: "^(Ocl2String.ocl2string false t)^"\n"
|
|
|
|
|
|
|
|
| cxt2string (Inv(p,NONE,t)) = (Rep_Core.string_of_path p)^"\n"
|
|
|
|
^" inv: "^(Ocl2String.ocl2string false t)^"\n"
|
|
|
|
| cxt2string (Inv(p,SOME cn,t)) = (Rep_Core.string_of_path p)^"\n"
|
|
|
|
^" inv "^cn^": "^(Ocl2String.ocl2string false t)^"\n"
|
|
|
|
|
|
|
|
| cxt2string (Attr(p,ty,derive,t)) = (Rep_Core.string_of_path p)^"\n"
|
|
|
|
^" derive: "^(Ocl2String.ocl2string false t)^"\n"
|
|
|
|
| cxt2string (Attr(p,ty,init,t)) = (Rep_Core.string_of_path p)^"\n"
|
|
|
|
^" init: "^(Ocl2String.ocl2string false t)^"\n"
|
|
|
|
| cxt2string (Attr(p,ty,def,t)) = (Rep_Core.string_of_path p)^"\n"
|
|
|
|
^" def: "^(Ocl2String.ocl2string false t)^"\n"
|
|
|
|
|
|
|
|
| cxt2string (Cond(p,s,l,ty,pre,NONE,t)) = (Rep_Core.string_of_path (tl p))^"::"^s^"("^(string_of_arglist l)^"):"^(Rep_OclType.string_of_OclType ty)^"\n"
|
|
|
|
^" pre: "^(Ocl2String.ocl2string false t)^"\n"
|
|
|
|
| cxt2string (Cond(p,s,l,ty,pre,SOME cn,t)) = (Rep_Core.string_of_path (tl p))^"::"^s^"("^(string_of_arglist l)^"):"^(Rep_OclType.string_of_OclType ty)^"\n"
|
|
|
|
^" pre "^cn^": "^(Ocl2String.ocl2string false t)^"\n"
|
|
|
|
| cxt2string (Cond(p,s,l,ty,post,NONE,t)) = (Rep_Core.string_of_path (tl p))^"::"^s^"("^(string_of_arglist l)^"):"^(Rep_OclType.string_of_OclType ty)^"\n"
|
|
|
|
^" post: "^(Ocl2String.ocl2string false t)^"\n"
|
|
|
|
| cxt2string (Cond(p,s,l,ty,post,SOME cn,t)) = (Rep_Core.string_of_path (tl p))^"::"^s^"("^(string_of_arglist l)^"):"^(Rep_OclType.string_of_OclType ty)^"\n"
|
|
|
|
^" post "^cn^": "^(Ocl2String.ocl2string false t)^"\n"
|
|
|
|
| cxt2string (Cond(p,s,l,ty,body,NONE,t)) = (Rep_Core.string_of_path (tl p))^"::"^s^"("^(string_of_arglist l)^"):"^(Rep_OclType.string_of_OclType ty)^"\n"
|
|
|
|
^" body: "^(Ocl2String.ocl2string false t)^"\n"
|
|
|
|
| cxt2string (Cond(p,s,l,ty,body,SOME cn,t)) = (Rep_Core.string_of_path (tl p))^"::"^s^"("^(string_of_arglist l)^"):"^(Rep_OclType.string_of_OclType ty)^"\n"
|
|
|
|
^" body "^cn^": "^(Ocl2String.ocl2string false t)^"\n"
|
|
|
|
|
|
|
|
| cxt2string (Guard(p,NONE,t)) = (Rep_Core.string_of_path p)^"\n"
|
|
|
|
^" guard: "^(Ocl2String.ocl2string false t)^"\n"
|
|
|
|
| cxt2string (Guard(p,SOME cn,t)) = (Rep_Core.string_of_path p)^"\n"
|
|
|
|
^" guard "^cn^": "^(Ocl2String.ocl2string false t)^"\n"
|
|
|
|
|
|
|
|
fun cxt_list2string ctxs = String.concat (map cxt2string ctxs)
|
2007-06-12 18:51:39 +00:00
|
|
|
|
2008-04-03 12:26:02 +00:00
|
|
|
fun rename_classifier path (Class{name=name,parent=parent,attributes=attributes,operations=operations,associations=associations,invariant=invariant,stereotypes=stereotypes,interfaces=interfaces,thyname=thyname,visibility=visibility,activity_graphs=activity_graphs}) =
|
|
|
|
let
|
2009-01-03 21:18:36 +00:00
|
|
|
val _ = Logger.debug2 ("Context.rename_classifier\n")
|
2008-04-03 12:26:02 +00:00
|
|
|
val res = Class {
|
|
|
|
name = Classifier (path),
|
|
|
|
parent=parent,
|
|
|
|
attributes=attributes,
|
|
|
|
operations=operations,
|
|
|
|
associations=associations,
|
|
|
|
invariant=invariant,
|
|
|
|
stereotypes=stereotypes,
|
|
|
|
interfaces=interfaces,
|
|
|
|
thyname=thyname,
|
|
|
|
visibility=visibility,
|
|
|
|
activity_graphs=activity_graphs
|
|
|
|
}
|
2009-01-03 21:18:36 +00:00
|
|
|
val _ = Logger.debug2 ("Context.rename_classifier\n")
|
2008-04-03 12:26:02 +00:00
|
|
|
in
|
|
|
|
res
|
|
|
|
end
|
|
|
|
|
|
|
|
fun merge_classifier ((a as Class{attributes=a_atts,operations=a_ops,invariant=a_invs,associations=a_assocs,...}),(b as Class{attributes=b_atts,operations=b_ops,invariant=b_invs,associations=b_assocs,...})) =
|
|
|
|
let
|
2009-01-03 21:18:36 +00:00
|
|
|
val _ = Logger.debug2 ("Context.merge_classifier\n")
|
2008-04-03 12:26:02 +00:00
|
|
|
val res = Class {
|
|
|
|
name = OclVoid,
|
|
|
|
parent=NONE,
|
|
|
|
attributes=a_atts@b_atts,
|
|
|
|
operations=a_ops@b_ops,
|
|
|
|
associations=a_assocs@b_assocs,
|
|
|
|
invariant=a_invs@b_invs,
|
|
|
|
stereotypes=[],
|
|
|
|
interfaces=[],
|
|
|
|
thyname=NONE,
|
|
|
|
visibility=public:Rep_Core.Visibility,
|
|
|
|
activity_graphs=[]
|
|
|
|
}
|
2009-01-03 21:18:36 +00:00
|
|
|
val _ = Logger.debug2 ("Context.merge_classifier\n")
|
2008-04-03 12:26:02 +00:00
|
|
|
in
|
|
|
|
res
|
|
|
|
end
|
|
|
|
|
|
|
|
fun merge_classifiers list =
|
|
|
|
let
|
2009-01-03 21:18:36 +00:00
|
|
|
val _ = Logger.debug2 ("Context.merge_classifiers\n")
|
2008-04-03 12:26:02 +00:00
|
|
|
val Empty_Class = Class{
|
|
|
|
name = OclVoid,
|
|
|
|
parent=NONE,
|
|
|
|
attributes=[],
|
|
|
|
operations=[],
|
|
|
|
associations=[],
|
|
|
|
invariant=[],
|
|
|
|
stereotypes=[],
|
|
|
|
interfaces=[],
|
|
|
|
thyname=NONE,
|
|
|
|
visibility=public:Rep_Core.Visibility,
|
|
|
|
activity_graphs=[]
|
|
|
|
}
|
|
|
|
val res = List.foldr (merge_classifier) Empty_Class list
|
2009-01-03 21:18:36 +00:00
|
|
|
val _ = Logger.debug2 ("Context.merge_classifier\n")
|
2008-04-03 12:26:02 +00:00
|
|
|
in
|
|
|
|
res
|
|
|
|
end
|
|
|
|
|
|
|
|
|
|
|
|
fun operations_to_classifier ops =
|
|
|
|
let
|
2009-01-03 21:18:36 +00:00
|
|
|
val _ = Logger.debug2 ("Context.operation_to_classifier\n")
|
2008-04-03 12:26:02 +00:00
|
|
|
val res = Class{
|
|
|
|
name = OclVoid,
|
|
|
|
parent=NONE,
|
|
|
|
attributes=[],
|
|
|
|
operations=ops,
|
|
|
|
associations=[],
|
|
|
|
invariant=[],
|
|
|
|
stereotypes=[],
|
|
|
|
interfaces=[],
|
|
|
|
thyname=NONE,
|
|
|
|
visibility=public:Rep_Core.Visibility,
|
|
|
|
activity_graphs=[]
|
|
|
|
}
|
2009-01-03 21:18:36 +00:00
|
|
|
val _ = Logger.debug2 ("Context.operation_to_classifier\n")
|
2008-04-03 12:26:02 +00:00
|
|
|
in
|
|
|
|
res
|
|
|
|
end
|
|
|
|
|
|
|
|
fun attributes_to_classifier atts =
|
|
|
|
let
|
2009-01-03 21:18:36 +00:00
|
|
|
val _ = Logger.debug2 ("Context.attributes_to_classifier\n")
|
2008-04-03 12:26:02 +00:00
|
|
|
val res = Class{
|
|
|
|
name = OclVoid,
|
|
|
|
parent=NONE,
|
|
|
|
attributes=atts,
|
|
|
|
operations=[],
|
|
|
|
associations=[],
|
|
|
|
invariant=[],
|
|
|
|
stereotypes=[],
|
|
|
|
interfaces=[],
|
|
|
|
thyname=NONE,
|
|
|
|
visibility=public:Rep_Core.Visibility,
|
|
|
|
activity_graphs=[]
|
|
|
|
}
|
2009-01-03 21:18:36 +00:00
|
|
|
val _ = Logger.debug2 ("Context.attributes_to_classifier\n")
|
2008-04-03 12:26:02 +00:00
|
|
|
in
|
|
|
|
res
|
|
|
|
end
|
|
|
|
|
|
|
|
fun constraints_to_classifier invs =
|
|
|
|
let
|
2009-01-03 21:18:36 +00:00
|
|
|
val _ = Logger.debug2 ("Context.constraints_to_classifier\n")
|
2008-04-03 12:26:02 +00:00
|
|
|
val res = Class{
|
|
|
|
name = OclVoid,
|
|
|
|
parent=NONE,
|
|
|
|
attributes=[],
|
|
|
|
operations=[],
|
|
|
|
associations=[],
|
|
|
|
invariant=invs,
|
|
|
|
stereotypes=[],
|
|
|
|
interfaces=[],
|
|
|
|
thyname=NONE,
|
|
|
|
visibility=public:Rep_Core.Visibility,
|
|
|
|
activity_graphs=[]
|
|
|
|
}
|
2009-01-03 21:18:36 +00:00
|
|
|
val _ = Logger.debug2 ("Context.constraints_to_classifier\n")
|
2008-04-03 12:26:02 +00:00
|
|
|
in
|
|
|
|
res
|
|
|
|
end
|
|
|
|
|
|
|
|
fun dispatch_pre_or_post (cond_type:ConditionType) (list:(ConditionType * string option * OclTerm) list) =
|
|
|
|
let
|
2009-01-03 21:18:36 +00:00
|
|
|
val _ = Logger.debug2 ("Context.dispatch_pre_or_post")
|
2008-04-03 12:26:02 +00:00
|
|
|
val filter = List.filter (fn (a,b,c) => if cond_type = a
|
|
|
|
then true
|
|
|
|
else false) list
|
|
|
|
val res = List.map (fn (a,b,c) => (b,c)) filter
|
2009-01-03 21:18:36 +00:00
|
|
|
val _ = Logger.debug2 ("Context.dispatch_pre_or_post")
|
2008-04-03 12:26:02 +00:00
|
|
|
in
|
|
|
|
res
|
|
|
|
end
|
2007-06-12 18:51:39 +00:00
|
|
|
end;
|