HOL-OCL
/
su4sml
1
0
Fork 0
Code Issues Pull Requests Releases Activity
su4sml/su4sml/src/ocl_parser/preprocessor.sml

780 lines
31 KiB
Standard ML
Raw Blame History

(*****************************************************************************
* su4sml --- a SML repository for managing (Secure)UML/OCL models
* http://projects.brucker.ch/su4sml/
*
* preprocessor.sml ---
* This file is part of su4sml.
*
* Copyright (c) 2005-2007 ETH Zurich, Switzerland
* 2008-2009 Achim D. Brucker, Germany
*
* 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$ *)
signature PREPROCESSOR =
sig
val preprocess_context_list : Context.context list -> Rep_Core.Classifier list -> Context.context list
val embed_bound_variables : (string * Rep_OclType.OclType) list -> Rep_OclTerm.OclTerm -> Rep_OclTerm.OclTerm
end
structure Preprocessor:PREPROCESSOR =
struct
open Rep_Helper
open Rep_Core
open Rep_OclTerm
open Rep_OclType
open Context
open RepParser
open XMI_DataTypes
open OclLibrary
type operation = Rep_Core.operation
type attribute = Rep_Core.attribute
(* The problem here is, that when parsing the ocl file, there is something the parser cannot
know. Therefore we have to solve the problem before to type check.
PROBLEM 1:
The parser can never know if it is an absolute call for an operation or an attribute, or
a relative call.
Example: x.hallo >= 0
Possiblity 1:
context A::f(x:Object):Integer
pre: x > 0
to get classifier x look up in the signature for Object x
Possiblity 2:
context A::f(y:Object):Integer
pre: x > 0
to get classifier x look up in the classifer list at self.x
This problem is solve by going through all the contexts, looking whether the attribute calls
refer to self or signature arguemnts.
Used methods:
- member
- fetch
- check_for_self
PROBLEM 2:
The parser parses a call to result following:
******************************************************
post: result = 0
AttributeCall (Variable("self",_),...,["result"], ...)
******************************************************
So we have to substitute this by: Variable ("result",typ_of_operation_return_typ)
PROBLEM 3:
The parser parses the OperationWithType calls wrong.
PROBLEM 4:
package simple
context A
inv : self.i->forAll(a:B | ...)
endpackage
but the type is not (Classifier (["B"]) but (Classifier (["simple","B"])
PROBLEM 5:
'@pre'-expressions needs to be treated separately
*)
(*
TEMPLATE FOR TERM:
fun fun_name (Varible (str,type)) =
| fun_name (Literal (str,type)) =
| fun_name (CollectionLiteral (collpart,typ)) =
| fun_name (If (cond,cond_type,then_e,then_type,else_e,else_type,res_type)) =
| fun_name (AttributeCall (sterm,styp,p,res_typ)) =
| fun_name (OperationCall (sterm,styp,pa,para,res_typ)) =
| fun_name (OperationWithType (sterm,stype,para_name,para_type,res_type)) =
| fun_name (Let (var_name,var_type,rhs,rhs_type,in_e,in_type)) =
| fun_name (Iterator (name,iter_vars,sterm,stype,body_e,body_type,res_type)) =
| fun_name (Iterate (iter_vars,result_var,sterm,stype,body_term,body_type,res)) =
| fun_name (AssociatonEndCall(sterm,stype,path,res)) =
| fun_name (Predicate (sterm,stype,path,args)) =
| fun_name (QualifiedAssociationEndCall(sterm,stype,qualifiers,path,res)) =
*)
(* RETURN: OclTerm *)
fun embed_atPre_expressions_collpart (CollectionItem (term,typ)) =
let
val _ = Logger.debug2 ("Preprocessor.embed_atPre_expression_collpart CollectionItem(...)\n")
val res = (CollectionItem (embed_atPre_expressions term,typ))
val _ = Logger.debug2 ("Preprocessor.embed_atPre_expression_collpart\n")
in
res
end
| embed_atPre_expressions_collpart (CollectionRange (term1,term2,typ)) =
let
val _ = Logger.debug2 ("Preprocessor.embed_atPre_expression_collpart CollectionRange(...)\n")
val res = (CollectionRange (embed_atPre_expressions term1, embed_atPre_expressions term2, typ))
val _ = Logger.debug2 ("Preprocessor.embed_atPre_expression_collpart\n")
in
res
end
and embed_atPre_expressions (Variable (str,typ)) =
let
val _ = Logger.debug2 ("Preprocessor.embed_atPre_expressions Variable(...)\n")
val res = (Variable (str,typ))
val _ = Logger.debug2 ("Preprocessor.embed_atPre_expressions\n")
in
res
end
| embed_atPre_expressions (Literal (str,typ)) =
let
val _ = Logger.debug2 ("Preprocessor.embed_atPre_expressions Literal(...)\n")
val res = (Literal (str,typ))
val _ = Logger.debug2 ("Preprocessor.embed_atPre_expressions\n")
in
res
end
| embed_atPre_expressions (CollectionLiteral (collpart,typ)) =
let
val _ = Logger.debug2 ("Preprocessor.embed_atPre_expressions CollectionLiteral(...)\n")
val res = (CollectionLiteral (List.map (embed_atPre_expressions_collpart) collpart,typ))
val _ = Logger.debug2 ("Preprocessor.embed_atPre_expressions\n")
in
res
end
| embed_atPre_expressions (If (cond,cond_type,then_e,then_type,else_e,else_type,res_type)) =
let
val _ = Logger.debug2 ("Preprocessor.embed_atPre_expressions Variable(...)\n")
val res = (If (embed_atPre_expressions cond,cond_type,embed_atPre_expressions then_e,then_type,embed_atPre_expressions else_e,else_type,res_type))
val _ = Logger.debug2 ("Preprocessor.embed_atPre_expressions\n")
in
res
end
| embed_atPre_expressions (AttributeCall (sterm,styp,p,res_typ)) =
let
val _ = Logger.debug2 ("Preprocessor.embed_atPre_expressions AttributeCall(...)\n")
val res =
if (List.last (p) = "atPre")
then (* atPre Call *)
(
if (List.length p = 1)
then (* self *)
(OperationCall (sterm,styp,[OclLibPackage,"OclAny","atPre"],[],DummyT))
else (* contains at least one 'normal' attribute *)
(AttributeCall (OperationCall (embed_atPre_expressions sterm,styp,[OclLibPackage,"OclAny","atPre"],[],DummyT),styp,real_path p,res_typ))
)
else (* normal Call *)
(AttributeCall (embed_atPre_expressions sterm,styp,p,res_typ))
val _ = Logger.debug2 ("Preprocessor.embed_atPre_expressions\n")
in
res
end
| embed_atPre_expressions (OperationCall (sterm,styp,pa,para,res_typ)) =
let
val _ = Logger.debug2 ("Preprocessor.embed_atPre_expressions OperationCall(...)\n")
val atpre_para = List.map (fn (a,b) => (embed_atPre_expressions a,b)) para
val res =
if (List.last (pa) = "atPre")
then (OperationCall (OperationCall (embed_atPre_expressions sterm,styp,real_path pa,atpre_para,res_typ),DummyT,[OclLibPackage,"OclAny","atPre"],[],DummyT))
else (OperationCall (embed_atPre_expressions sterm,styp,pa,atpre_para,res_typ))
val _ = Logger.debug2 ("Preprocessor.embed_atPre_expressions\n")
in
res
end
| embed_atPre_expressions (OperationWithType (sterm,stype,para_name,para_type,res_type)) =
let
val _ = Logger.debug2 ("Preprocessor.embed_atPre_expressions OperationWithType(...)\n")
val res = (OperationWithType (embed_atPre_expressions sterm,stype,para_name,para_type,res_type))
val _ = Logger.debug2 ("Preprocessor.embed_atPre_expressions\n")
in
res
end
| embed_atPre_expressions (Let (var_name,var_type,rhs,rhs_type,in_e,in_type)) =
let
val _ = Logger.debug2 ("Preprocessor.embed_atPre_expressions Let(...)\n")
val res = (Let (var_name,var_type,embed_atPre_expressions rhs,rhs_type,embed_atPre_expressions in_e,in_type))
val _ = Logger.debug2 ("Preprocessor.embed_atPre_expressions\n")
in
res
end
| embed_atPre_expressions (Iterator (name,iter_vars,sterm,stype,body_e,body_type,res_type)) =
let
val _ = Logger.debug2 ("Preprocessor.embed_atPre_expressions Iterator(...)\n")
val res = (Iterator (name,iter_vars,embed_atPre_expressions sterm,stype,embed_atPre_expressions body_e,body_type,res_type))
val _ = Logger.debug2 ("Preprocessor.embed_atPre_expressions\n")
in
res
end
| embed_atPre_expressions (Iterate (iter_vars,acc_var_name,acc_var_type,acc_var_term,sterm,stype,bterm,btype,res_type)) =
let
val _ = Logger.debug2 ("Preprocessor.embed_atPre_expressions Iterate(...)\n")
val res = (Iterate (iter_vars,acc_var_name,acc_var_type,acc_var_term,embed_atPre_expressions sterm,stype,embed_atPre_expressions bterm,btype,res_type))
val _ = Logger.debug2 ("Preprocessor.embed_atPre_expression\n")
in
res
end
(* RETURN: OclTerm *)
fun embed_bound_variable (str,typ) (Variable(s,t)) =
let
val _ = Logger.debug2 ("Preprocessor.embed_bound_variable Variable(...)\n")
val _ = Logger.debug3 ("1 Bound variable '" ^ s ^ "' in 'AttributeCall': " ^ Ocl2String.ocl2string false (Variable(s,t)) ^ "\n")
val res =
if (str = s ) then
Variable(s,typ)
else
Variable(s,t)
val _ = Logger.debug2 ("Preprocessor.embed_bound_variable\n")
in
res
end
| embed_bound_variable (s,typ) (AttributeCall (sterm,styp,path,rtyp)) =
let
val _ = Logger.debug2 ("Preprocessor.embed_bound_variable AttributeCall(...)\n")
val _ = Logger.debug3 ("2 Bound variable '" ^ s ^ "' in 'AttributeCall': " ^ Ocl2String.ocl2string false (AttributeCall (sterm,styp,path,rtyp)) ^ "\n")
val res =
if (List.last path = s) then
(* embed variable *)
(Variable (s,typ))
else
(AttributeCall (embed_bound_variable (s,typ) sterm,styp,path,rtyp))
val _ = Logger.debug2 ("Preprocessor.embed_bound_variable\n")
in
res
end
| embed_bound_variable (s,typ) (OperationCall (sterm,styp,path,args,rtyp)) =
let
val _ = Logger.debug2 ("Preprocessor.embed_bound_variable AttributeCall(...)\n")
val _ = Logger.debug3 ("Bound variable '" ^ s ^ "' in 'OperationCall': " ^ Ocl2String.ocl2string false (OperationCall (sterm,styp,path,args,rtyp)) ^ "\n")
val res = (OperationCall (embed_bound_variable (s,typ) sterm,styp,path,embed_bound_args (s,typ) args ,rtyp))
val _ = Logger.debug2 ("Preprocessor.embed_bound_variable\n")
in
res
end
| embed_bound_variable (s,typ) (Iterator (name,iter_list,sterm,styp,expr,expr_typ,rtyp)) =
let
val _ = Logger.debug2 ("Preprocessor.embed_bound_variable AttributeCall(...)\n")
val _ = Logger.debug3 ("Bound variable '" ^ s ^ "' in 'Iterator': " ^ Ocl2String.ocl2string false (Iterator (name,iter_list,sterm,styp,expr,expr_typ,rtyp)) ^ "\n")
val res = (Iterator (name,iter_list,embed_bound_variable (s,typ) sterm,styp,embed_bound_variables iter_list (embed_bound_variable (s,typ) expr),expr_typ,rtyp))
val _ = Logger.debug2 ("Preprocessor.embed_bound_variable\n")
in
res
end
| embed_bound_variable (s,typ) (Iterate (iter_vars,acc_name,acc_type,acc_term,sterm,stype,bterm,btype,res_type)) =
let
val _ = Logger.debug2 ("Preprocessor.embed_bound_variable AttributeCall(...)\n")
val _ = Logger.debug1 ("Bound variable '" ^ s ^ "' in 'Iterate': " ^ Ocl2String.ocl2string false (Iterate (iter_vars,acc_name,acc_type,acc_term,sterm,stype,bterm,btype,res_type)) ^ "\n")
val res = (Iterate (iter_vars,acc_name,acc_type,acc_term,embed_bound_variable (s,typ) sterm,stype,embed_bound_variable (s,typ) bterm,btype,res_type))
val _ = Logger.debug2 ("Preprocessor.embed_bound_variable\n")
in
res
end
| embed_bound_variable (s,typ) (Let (var_name,var_type,rhs,rhs_type,in_e,in_type)) =
let
val _ = Logger.debug2 ("Preprocessor.embed_bound_variable AttributeCall(...)\n")
val _ = Logger.debug3 ("Bound variable '" ^ s ^ "' in 'Let': " ^ Ocl2String.ocl2string false (Let (var_name,var_type,rhs,rhs_type,in_e,in_type)) ^ "\n")
val embed_in_e = embed_bound_variable (var_name,var_type) in_e
val res = (Let (var_name,var_type,embed_bound_variable (s,typ) rhs,rhs_type,embed_bound_variable (s,typ) embed_in_e,in_type))
val _ = Logger.debug2 ("Preprocessor.embed_bound_variable\n")
in
res
end
| embed_bound_variable (s,typ) (If (cond,cond_type,then_e,then_type,else_e,else_type,res_type)) =
let
val _ = Logger.debug2 ("Preprocessor.embed_bound_variable AttributeCall(...)\n")
val _ = Logger.debug3 ("Bound variable '" ^ s ^ "' in 'If' ..." ^ "\n")
val res = (If (embed_bound_variable (s,typ) cond,cond_type,embed_bound_variable (s,typ) then_e,then_type,embed_bound_variable (s,typ) else_e,else_type,res_type))
val _ = Logger.debug2 ("Preprocessor.embed_bound_variable\n")
in
res
end
| embed_bound_variable (s,typ) term = term
(* RETURN: IDENDITAET *)
and swap f a b = f b a
(* RETURN: OclTerm *)
and embed_bound_variables [] term = term
| embed_bound_variables (h::tail) term =
(embed_bound_variables tail (embed_bound_variable h term))
(* RETURN: (OclTerm * OclType) list *)
and embed_bound_args (str,typ) [] = []
| embed_bound_args (str,typ) (h::arg_list) =
(embed_bound_variable (str,typ) (#1 h),#2 h)::(embed_bound_args (str,typ) arg_list)
(* RETURN: OclTerm *)
(* Better readable source code *)
fun embed_method_arguments [] term = term
| embed_method_arguments ((str,typ)::tail) term =
embed_method_arguments tail (embed_bound_variable (str,typ) term)
(* RETURN: OclTerm *)
fun embed_iterator_variables arg_list term = embed_method_arguments arg_list term
(* For the existing variables in Ocl.
There is only one (I know, maybe some more).
It can be easily extended here
*)
(* RETURN: CollectionPart list *)
fun generate_variables_coll_list ((CollectionItem (term,typ))::tail) path meth_name model
= (CollectionItem(generate_variables term path meth_name model,typ))
::(generate_variables_coll_list tail path meth_name model)
| generate_variables_coll_list ((CollectionRange (first_term,last_term,typ))::tail)
path meth_name model
= (CollectionRange(generate_variables
first_term path meth_name model,
generate_variables last_term path meth_name model,typ))
::(generate_variables_coll_list tail path meth_name model)
| generate_variables_coll_list [] path meth_name model = []
(* RETURN: OclTerm *)
and generate_variables (Literal (paras)) path meth_name model = Literal (paras)
| generate_variables (Variable (paras)) path meth_name model = Variable (paras)
| generate_variables (CollectionLiteral ([],dummyT)) path meth_name model =
(CollectionLiteral ([],Set OclAny)) (* HACK/ DefaultType for Empty List: OclAny *)
| generate_variables (CollectionLiteral (collpart_list,typ)) path meth_name model =
(CollectionLiteral (generate_variables_coll_list collpart_list path meth_name model,typ))
| generate_variables (If (cond,cond_type,then_e,then_type,else_e,else_type,res_type)) path meth_name model=
(If (generate_variables cond path meth_name model,cond_type,generate_variables then_e path meth_name model,then_type,generate_variables else_e path meth_name model,else_type,res_type))
| generate_variables (AttributeCall (src,src_type,["result"],_)) path meth_name model =
let
val _ = Logger.debug2 ("Preprocessor.generate_variables: AttributeCall\n")
val new_src = generate_variables src path meth_name model
val _ = List.app (print o (fn x => x^"\n") o string_of_path o name_of ) model
val classifier = class_of path (model,[])
val _ = Logger.debug4 "classifier found\n"
val meth = get_operation meth_name classifier (model,[])
val res = (Variable ("result",(#result (meth))))
val _ = Logger.debug2 ("Preprocessor.generate_variables\n")
in
res
end
| generate_variables (AttributeCall (sterm,styp,p,res_typ)) path meth_name model =
(AttributeCall (generate_variables sterm path meth_name model,styp,p,res_typ))
| generate_variables (OperationCall (sterm,styp,pa,paras,res_typ)) path meth_name model =
let
val _ = Logger.debug2 ("Preprocessor.generate_variables \n")
val new_para_terms = List.map (fn (a,b) => generate_variables (a) path meth_name model) paras
val new_paras = List.map (fn a => (a, type_of_term a)) new_para_terms
val res =
(OperationCall (generate_variables sterm path meth_name model,styp,pa,new_paras,res_typ))
val _ = Logger.debug2 ("Preprocessor.generate_variables\n")
in
res
end
| generate_variables (OperationWithType (sterm,stype,para_name,para_type,res_typ)) path meth_name model =
let
val _ = Logger.debug2 ("Preprocessor.generate_variables \n")
val res =
(OperationWithType (generate_variables sterm path meth_name model,stype,para_name,para_type,res_typ))
val _ = Logger.debug2 ("Preprocessor.generate_variables\n")
in
res
end
| generate_variables (Let (var_name,var_type,rhs,rhs_type,in_e,in_type)) path meth_name model =
(Let (var_name,var_type,generate_variables rhs path meth_name model,rhs_type,generate_variables in_e path meth_name model,in_type))
| generate_variables (Iterator (name,iter_vars,sterm,stype,body_e,body_type,res_type)) path meth_name model =
(Iterator (name,iter_vars,generate_variables sterm path meth_name model,stype,generate_variables body_e path meth_name model,body_type,res_type))
(* RETURN: (string*OclType) *)
fun fetch (x,((y1,y2)::tail)) =
if (x=y1) then
(y1,y2)
else
fetch (x,tail)
(* RETURN: OclTerm list *)
fun check_for_self_paras arg_list typ [] model = []
| check_for_self_paras arg_list typ ((term,t)::tail) model =
let
val _ = Logger.debug2 ("Preprocessor.check_for_self_paras\n")
val res = ((check_for_self arg_list typ term model),t)::(check_for_self_paras arg_list typ tail model)
val _ = Logger.debug2 ("Preprocessor.check_for_self_paras\n")
in
res
end
and check_for_self_collpart arg_list typ model (CollectionItem (term,ctyp)) =
let
val _ = Logger.debug2 ("Preprocessor.check_for_self_collpart CollectionItem(...)\n")
val res = (CollectionItem (check_for_self arg_list typ term model,ctyp))
val _ = Logger.debug2 ("Preprocessor.check_for_self_collpart\n")
in
res
end
| check_for_self_collpart arg_list typ model (CollectionRange (term1,term2,ctyp)) =
let
val _ = Logger.debug2 ("Preprocessor.check_for_self_collpart CollectionRange(...)\n")
val res = (CollectionRange (check_for_self arg_list typ term1 model,
check_for_self arg_list typ term2 model, ctyp))
val _ = Logger.debug2 ("Preprocessor.check_for_self_collpart\n")
in
res
end
(* RETURN: OclTerm *)
and check_for_self arg_list typ (AttributeCall (Variable("dummy_source",_),_,path,_)) model=
let
val _ = Logger.debug2 ("Preprocessor.check_for_self: dummy_source AttributeCall\n")
val test = (member (List.last path) (List.map (#1) arg_list))
val _ = Logger.debug3 ("member? "^ Bool.toString (test) ^ "\n")
val res =
if (List.last path = "self") then
(* 'self' is writen in the ocl file *)
(Variable ("self",typ))
else
(AttributeCall (Variable ("self",typ),DummyT,path,DummyT))
val _ = Logger.debug2 ("Preprocessor.check_for_self\n")
in
res
end
| check_for_self arg_list typ (CollectionLiteral (collpart,ctyp)) model =
let
val _ = Logger.debug2 ("Preprocessor.check_for_self: dummy_source CollectionLiteral\n")
val res = (CollectionLiteral (List.map (check_for_self_collpart arg_list typ model) collpart,ctyp))
val _ = Logger.debug2 ("Preprocessor.check_for_self\n")
in
res
end
| check_for_self arg_list typ (AttributeCall (source_term,source_typ,path,ret_typ)) model =
let
val _ = Logger.debug2 ("Preprocessor.check_for_self: complex AttributeCall\n")
val res = (AttributeCall (check_for_self arg_list typ source_term model,source_typ,path,ret_typ))
val _ = Logger.debug2 ("Preprocessor.check_for_self\n")
in
res
end
(* OperationCall *)
| check_for_self arg_list typ (OperationCall (Variable ("dummy_source",_),source_type,path,paras,ret_typ)) model =
let
val test = (member (List.last path) (List.map (#1) arg_list))
val _ = Logger.debug3 ("member2? "^ Bool.toString (test) ^ "\n")
in
if (member (List.last path) (List.map (#1) arg_list))
then
(* Call of a method parameter *)
(Variable ((#1 (fetch ((List.last path), arg_list))), (#2 (fetch ((List.last path),arg_list)))))
else
(* Call of a member of the class *)
(OperationCall (Variable ("self",typ),source_type,path,check_for_self_paras arg_list typ paras model,ret_typ))
end
| check_for_self arg_list typ (OperationCall (source_term,source_typ,path,paras,ret_typ)) model =
let
val _ = Logger.debug2 ("Preprocessor.check_for_self complex OperationCall\n")
val res = (OperationCall (check_for_self arg_list typ source_term model ,source_typ,path,check_for_self_paras arg_list typ paras model,ret_typ))
val _ = Logger.debug2 ("Preprocessor.check_for_self\n")
in
res
end
| check_for_self arg_list typ (Iterator (name,iter_var,sterm,styp,expr,expr_typ,res_typ)) model =
let
val _ = Logger.debug2 ("Preprocessor.check_for_self: Iterator(...)\n")
val res = (Iterator (name,iter_var,(check_for_self arg_list typ sterm model),styp,(check_for_self arg_list typ expr model),expr_typ,res_typ))
val _ = Logger.debug2 ("Preprocessor.check_for_self\n")
in
res
end
| check_for_self arg_list typ (Iterate (iter_vars,acc_name,acc_type,acc_term,sterm,stype,bterm,btype,res_type)) model =
let
val _ = Logger.debug2 ("Preprocessor.check_for_self Iterate \n")
val res = (Iterate (iter_vars,acc_name,acc_type,acc_term,(check_for_self arg_list typ sterm model),stype,(check_for_self arg_list typ bterm model),btype,res_type))
val _ = Logger.debug2("Preprocessor.check_for_self\n")
in
res
end
| check_for_self arg_list typ (Let (str,ttyp,rhs_term,rhs_typ,in_term,in_typ)) model =
let
val _ = Logger.debug2 ("Preprocessor.check_for_self Let (...)\n")
val self_rhs_term = check_for_self arg_list typ rhs_term model
val self_in_term = check_for_self arg_list typ in_term model
val res = (Let (str,ttyp,self_rhs_term,rhs_typ,self_in_term,in_typ))
val _ = Logger.debug2 ("Preprocessor.check_for_self\n")
in
res
end
| check_for_self arg_list typ (If (cond,cond_typ,expr1,typ1,expr2,typ2,res_typ)) model =
let
val _ = Logger.debug2 ("Preprocessor.check_for_self If (...)\n")
val self_cond = check_for_self arg_list typ cond model
val self_expr1 = check_for_self arg_list typ expr1 model
val self_expr2 = check_for_self arg_list typ expr2 model
val res = (If (self_cond,cond_typ,self_expr1,typ1,self_expr2,typ2,res_typ))
val _ = Logger.debug2 ("Preprocessor.check_for_self\n")
in
res
end
| check_for_self arg_list typ term model = term
(*
fun prefix_OperationWithType_CollectionPart prefix (CollectionItem(term,typ)) =
let
val new_term = prefix_OperationWithType prefix term
in
(CollectionItem(new_term,type_of_term new_term))
end
| prefix_OperationWithType_CollectionPart prefix (CollectionRange(term1,term2,typ)) =
let
val new_term1 = prefix_OperationWithType prefix term1
val new_term2 = prefix_OperationWithType prefix term2
in
(CollectionRange(new_term1,new_term2,type_of_term new_term1))
end
and prefix_OperationWithType prefix (Variable (str,typ)) = (Variable (str,typ))
| prefix_OperationWithType prefix (Literal (str,typ)) = (Literal (str,typ))
| prefix_OperationWithType prefix (CollectionLiteral (collparts,typ)) =
let
val new_collparts = List.map (fn a => prefix_OperationWithType_CollectionPart prefix a) collparts
val new_type = type_of_CollPart (List.hd(new_collparts))
in
CollectionLiteral(new_collparts,new_type)
end
| prefix_OperationWithType prefix (If (cond,cond_type,then_e,then_type,else_e,else_type,res_type)) =
let
val new_cond = prefix_OperationWithType prefix cond
val new_cond_type = type_of_term new_cond
val new_then_e = prefix_OperationWithType prefix then_e
val new_then_type = type_of_term new_then_e
val new_else_e = prefix_OperationWithType prefix else_e
val new_else_type = type_of_term new_else_e
val new_res_type = new_then_type
in
(If (new_cond,new_cond_type,new_then_e,new_then_type,new_else_e,new_else_type,new_res_type))
end
| prefix_OperationWithType prefix (QualifiedAssociationEndCall(sterm,stype,qualifiers,path,res)) =
let
val new_term = prefix_OperationWithType prefix sterm
val new_type = type_of_term new_term
val new_qualifiers = List.map (fn (a,b) =>
let
val new_a = prefix_OperationWithType prefix a
val new_a_type = type_of_term a
in
(new_a,new_a_type)
end
) qualifiers
in
QualifiedAssociationEndCall(new_term,new_type,new_qualifiers,path,res)
end
| prefix_OperationWithType prefix (AttributeCall (sterm,styp,p,res_typ)) =
let
val new_term = prefix_OperationWithType prefix sterm
val new_type = type_of_term new_term
in
AttributeCall(new_term,new_type,p,res_typ)
end
| prefix_OperationWithType prefix (AssociationEndCall(sterm,stype,path,res)) =
let
val new_term = prefix_OperationWithType prefix sterm
val new_type = type_of_term new_term
in
AssociationEndCall(new_term,new_type,path,res)
end
| prefix_OperationWithType prefix (OperationCall (sterm,styp,pa,args,res_typ)) =
(* if it is an OperationWithType,
* then it gets parsed like:
*
*
* OperationCall
* (source_term,
* DummyT,
* ["oclIsTypeOf"],
* [(AttributeCall(Variable ("dummy_source",DummyT),DummyT,["Chair"],DummyT),DummyT)],
* DummyT)
*)
(
case args of
[(AttributeCall(Variable("dummy_source",DummyT),DummyT,path,DummyT),DummyT)] =>
(** OperationWithType **)
let
val new_term = prefix_OperationWithType prefix sterm
val new_type = type_of_term new_term
val new_path = prefix_path prefix path
val new_args = [(AttributeCall(Variable("dummy_source",DummyT),DummyT,new_path,DummyT),DummyT)]
in
(OperationCall(new_term,new_type,pa,new_args,res_typ))
end
| x =>
(** OperationCall **)
let
val new_term = prefix_OperationWithType prefix sterm
val new_type = type_of_term new_term
val new_args = List.map (fn (a,b) =>
let
val new_a = prefix_OperationWithType prefix a
val new_a_type = type_of_term new_a
in
(new_a,new_a_type)
end ) args
in
OperationCall(new_term,new_type,pa,new_args,res_typ)
end
)
| prefix_OperationWithType prefix (Predicate (sterm,stype,path,args)) =
let
val new_term = prefix_OperationWithType prefix sterm
val new_type = type_of_term new_term
val new_args = List.map (fn (a,b) =>
let
val new_a = prefix_OperationWithType prefix a
val new_a_type = type_of_term new_a
in
(new_a,new_a_type)
end ) args
in
Predicate (new_term,new_type,path,new_args)
end
| prefix_OperationWithType prefix (Let (var_name,var_type,rhs,rhs_type,in_e,in_type)) =
let
val new_rhs = prefix_OperationWithType prefix rhs
val new_rhs_type = type_of_term new_rhs
val new_in_e = prefix_OperationWithType prefix in_e
val new_in_type = type_of_term new_in_e
in
(Let(var_name,var_type,new_rhs,new_rhs_type,new_in_e,new_in_type))
end
| prefix_OperationWithType prefix (Iterator (name,iter_vars,sterm,stype,body_e,body_type,res_type)) =
let
val new_term = prefix_OperationWithType prefix sterm
val new_type = type_of_term new_term
val new_body = prefix_OperationWithType prefix body_e
val new_body_type = type_of_term new_body
val new_res_type = res_type
in
Iterator(name,iter_vars,new_term,new_type,new_body,new_body_type,res_type)
end
| prefix_OperationWithType prefix (Iterate (iter_vars,res_string,res_type,res_term,sterm,stype,body_term,body_type,res)) =
let
val new_term = prefix_OperationWithType prefix sterm
val new_type = type_of_term new_term
val new_res_term = prefix_OperationWithType prefix res_term
val new_body = prefix_OperationWithType prefix body_term
val new_body_type = type_of_term new_body
in
Iterate(iter_vars,res_string,res_type,new_res_term,new_term,new_type,new_body,new_body_type,res)
end
*)
(* RETURN: Context *)
fun preprocess_context (Cond (path,op_name,op_sign,result_type,cond,pre_name,expr)) model =
let
(* embed 'result' variable *)
val _ = Logger.debug2 ("Preprocessor.preprocess_context Cond(...)\n")
val _ = Logger.debug3 ("Embed result variable \n")
val vexpr = generate_variables expr path op_name model
val _ = Logger.debug3 ("Variable 'result' embeded ... \n")
(* embed method arguments *)
val class = class_of_type (Classifier (path)) (model,[])
val prfx = package_of class
val prefixed_op_sign = List.map (fn (a,b) => (a,prefix_type prfx b)) op_sign
val prefixed_result_type = prefix_type prfx result_type
val eexpr = embed_method_arguments prefixed_op_sign vexpr
(* embed '@pre'-expressions *)
val pexpr = embed_atPre_expressions eexpr
val res =
(Cond (path,op_name,prefixed_op_sign,prefixed_result_type,cond,pre_name,(check_for_self prefixed_op_sign (Classifier (path)) pexpr model)))
val _ = Logger.debug2 ("Preprocessor.preprocess_context\n")
in
res
end
| preprocess_context (Inv (path,string,term)) model =
let
val _ = Logger.debug2 ("Preprocessor.preprocess_context Inv (...)\n")
(* embed '@pre'-expressions *)
val pexpr = embed_atPre_expressions term
val res = (Inv (path,string,(check_for_self [] (Classifier (path)) pexpr model)))
val _ = Logger.debug2 ("Preprocessor.preprocess_context\n")
in
res
end
| preprocess_context (Attr (path,typ,aoa,expr)) model =
let
val _ = Logger.debug2 ("Preprocessor.preprocess_context Attr(...)\n")
(* embed '@pre'-expressions *)
val pexpr = embed_atPre_expressions expr
val res = (Attr (path,typ,aoa,check_for_self [] (Classifier (path)) pexpr model))
val _ = Logger.debug2 ("Preprocessor.preprocess_context\n")
in
res
end
| preprocess_context c model =
let
val _ = Logger.debug2 ("Preprocessor.preprocess_context: others" ^ "\n")
val res = c
val _ = Logger.debug2 ("Preprocessor.preprocess_context\n")
in
res
end
(* RETURN: Context list *)
fun preprocess_context_list [] model = []
| preprocess_context_list (h::context_list_tail) model =
let
val _ = Logger.debug2 ("Preprocessor.preprocess_context_list\n")
val res = (preprocess_context h model)::(preprocess_context_list context_list_tail model)
val _ = Logger.debug2 ("Preprocessor.preprocess_context_list\n")
in
res
end
end
Reference in New Issue View Git Blame Copy Permalink