integrated iterate support from Manuel
git-svn-id: https://projects.brucker.ch/su4sml/svn/infsec-import/trunk/src/su4sml@6727 3260e6d1-4efc-4170-b0a7-36055960796d
This commit is contained in:
parent
c9ae80e1f0
commit
582ce9ccb6
|
|
@ -203,7 +203,15 @@ fun ocl2string show_types oclterm =
|
|||
(* Iterate *)
|
||||
(**************************************)
|
||||
(* Error *)
|
||||
| Iterate (_,s,_,_,src,_,c,_,_) => error ("error: unknown Iterate '"^(s)^"' in in ocl2string")
|
||||
| Iterate ([],acc_name,acc_type,acc_term,sterm,stype,bterm,btype,res_type) =>
|
||||
(ocl2string false sterm) ^ "->" ^ "iterate(" ^ acc_name ^ ":" ^ (Rep_OclType.string_of_OclType acc_type) ^ (ocl2string false acc_term) ^ (ocl2string false bterm)
|
||||
| Iterate (iter_vars,acc_name,acc_type,acc_term,sterm,stype,bterm,btype,res_type) =>
|
||||
let
|
||||
fun string_of_vars [] = ""
|
||||
| string_of_vars ((string,typ)::tail) = (string ^ ":" ^ (Rep_OclType.string_of_OclType typ))^(string_of_vars tail)
|
||||
in
|
||||
(ocl2string false sterm) ^ "->" ^ "iterate(" ^ (string_of_vars iter_vars) ^ acc_name ^ ":" ^ (Rep_OclType.string_of_OclType acc_type) ^ (ocl2string false acc_term) ^ (ocl2string false bterm)
|
||||
end
|
||||
(**************************************)
|
||||
(* Iterator *)
|
||||
(**************************************)
|
||||
|
|
@ -217,17 +225,17 @@ fun ocl2string show_types oclterm =
|
|||
else (ocl2string show_types src)^"->"^iname^"("
|
||||
^(cs_list (map #1 vars))
|
||||
^"|"^(ocl2string show_types c)^")"
|
||||
(*
|
||||
(* OCL Collection *)
|
||||
(*
|
||||
| Iterate (src,styp,["oclLib",classifier,"iterate"],args,Collection _) => OclIterate u C be e
|
||||
| Iterate (src,styp,["oclLib",classifier,"isUnique"],args,Collection _) => OclIsUnique u C be
|
||||
| Iterate (src,styp,["oclLib",classifier,"one"],args,Collection _) => OclOne u C be
|
||||
| Iterate (src,styp,["oclLib",classifier,"any"],args,Collection _) => OclAny u C be
|
||||
(* OCL OrderedSet *)
|
||||
| Iterate (src,styp,["oclLib",classifier,"count"],[(arg,_)],OrderedSet _) => OclOSetCount u S e *)
|
||||
| Iterate (src,styp,["oclLib",classifier,"count"],[(arg,_)],OrderedSet _) => OclOSetCount u S e *)
|
||||
(* Error *)
|
||||
(* | Iterator (s,_,_,_,_,_,_) => error ("error: unknown Iterator '"^(s)^"' in in ocl2string")
|
||||
*) (**************************************)
|
||||
(* | Iterator (s,_,_,_,_,_,_) => error ("error: unknown Iterator '"^(s)^"' in in ocl2string") *)
|
||||
(**************************************)
|
||||
(* Catch out *)
|
||||
(**************************************)
|
||||
(* Error *)
|
||||
|
|
|
|||
|
|
@ -229,6 +229,18 @@ fun add_source (source,(AttributeCall (_, _, path, res_typ ))) =
|
|||
| add_source (source, If (paras)) =
|
||||
(* If has no source *)
|
||||
If (paras)
|
||||
| add_source (source, Iterate([],acc_var_name,acc_var_type,acc_var_term,sterm,stype,bterm,btype,res_type)) =
|
||||
let
|
||||
val _ = trace low ("source added for Iterate ..." ^ "\n");
|
||||
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
|
||||
val _ = trace high ("source added for Iterate ..." ^ "\n");
|
||||
in
|
||||
(Iterate (iter_vars,acc_var_name,acc_var_type,acc_var_term,source,DummyT,bterm,btype,res_type))
|
||||
end
|
||||
|
||||
(* RETURN: OclTerm list *)
|
||||
fun add_source_to_list source (h::tail) = (add_source (source,h))::tail
|
||||
|
|
|
|||
|
|
@ -341,6 +341,14 @@ and prefix_expression ext_path (Variable (s,t)) = (Variable (s,t))
|
|||
(OperationWithType (prefix_expression ext_path sterm,stype,para_name,para_type,res_type))
|
||||
| prefix_expression ext_path (CollectionLiteral (coll_part_list,typ)) =
|
||||
(CollectionLiteral (List.map (prefix_collectionpart ext_path) coll_part_list,typ))
|
||||
| prefix_expression ext_path (Iterate (iter_vars,acc_var_name,acc_var_type,acc_var_term,sterm,stype,bterm,btype,restype)) =
|
||||
let
|
||||
val prefixed_vars = List.map (fn a => (#1 a,prefix_type ext_path (#2 a))) iter_vars
|
||||
val prefix_acc_type = prefix_type ext_path acc_var_type
|
||||
in
|
||||
(Iterate (prefixed_vars,acc_var_name,prefix_acc_type,acc_var_term,sterm,stype,bterm,btype,restype))
|
||||
end
|
||||
|
||||
|
||||
(* RETURN: OclType *)
|
||||
fun template_parameter typ =
|
||||
|
|
|
|||
|
|
@ -262,7 +262,7 @@ exception NotYetSupported of string
|
|||
| msg_operator_cs of OclTerm
|
||||
| property_call_parameters_cs of (OclTerm * OclType) list
|
||||
| qualifiers of CollectionPart list
|
||||
| iterate_vars_cs
|
||||
| iterate_vars_cs of (string * OclType) list
|
||||
| initialized_variable_cs of (string * OclType * OclTerm)
|
||||
| actual_parameter_list_cs of (OclTerm * OclType) list
|
||||
| actual_parameter_list_tail_cs of (OclTerm * OclType) list
|
||||
|
|
@ -625,14 +625,14 @@ arrow_property_call_exp_cs: iterator_name_cs PAREN_OPEN expression P
|
|||
| simple_name PAREN_OPEN PAREN_CLOSE (trace low ("arrow_property_call_exp_cs..." ^ "\n");OperationCall (Variable ("dummy_source",DummyT),DummyT,(["arrow"]@[simple_name]),[],DummyT))
|
||||
| simple_name PAREN_OPEN actual_parameter_list_cs PAREN_CLOSE (OperationCall (Variable ("dummy_source",DummyT),DummyT,(["arrow"]@[simple_name]),actual_parameter_list_cs,DummyT))
|
||||
(*
|
||||
| ITERATE PAREN_OPEN initialized_variable_cs VERTICAL_BAR expression PAREN_CLOSE ()
|
||||
| ITERATE PAREN_OPEN iterate_vars_cs initialize_variable_cs VERTICAL_BAR expression PAREN_CLOSE ()
|
||||
| ITERATE PAREN_OPEN initialized_variable_cs VERTICAL_BAR expression PAREN_CLOSE (Iterate ([],(#1 initialized_variable_cs),(#2 initialized_variable_cs),(#3 initialized_variable_cs),Variable ("dummy_source",DummyT),DummyT,expression,DummyT,DummyT))
|
||||
*)
|
||||
| ITERATE PAREN_OPEN iterate_vars_cs initialized_variable_cs VERTICAL_BAR expression PAREN_CLOSE (Iterate (iterate_vars_cs,(#1 (initialized_variable_cs)),(#2 (initialized_variable_cs)),(#3 (initialized_variable_cs)),Variable ("dummy_source",DummyT),DummyT,expression,DummyT,DummyT))
|
||||
|
||||
|
||||
(*
|
||||
(* RETURN: (string * OclType) list *)
|
||||
iterate_vars_cs : actual_parameter_list_cs SEMI_COLON ()
|
||||
*)
|
||||
iterate_vars_cs : formal_parameter_list_cs SEMI_COLON (formal_parameter_list_cs)
|
||||
|
||||
(* RETURN: (string * OclType) list *)
|
||||
iterator_vars_cs : formal_parameter_list_cs VERTICAL_BAR (formal_parameter_list_cs)
|
||||
|
||||
|
|
@ -707,7 +707,7 @@ initialized_variable_list_tail_cs_p : initialized_variable_list_tail_cs
|
|||
(* RETURN: (string * OclType * OclTerm) *)
|
||||
initialized_variable_list_tail_cs : COMMA initialized_variable_cs (initialized_variable_cs)
|
||||
|
||||
(* RETURN: (string * OclType * OclTerm*)
|
||||
(* RETURN: string * OclType * OclTerm *)
|
||||
initialized_variable_cs : formal_parameter_cs variable_initializer ((#1 formal_parameter_cs),(#2 formal_parameter_cs),variable_initializer)
|
||||
|
||||
(* RETURN: (string * OclType) *)
|
||||
|
|
|
|||
|
|
@ -1,44 +1,3 @@
|
|||
(*****************************************************************************
|
||||
* su4sml --- a SML repository for managing (Secure)UML/OCL models
|
||||
* http://projects.brucker.ch/su4sml/
|
||||
*
|
||||
* ocl.grm.sig ---
|
||||
* 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$ *)
|
||||
|
||||
signature OclParser_TOKENS =
|
||||
sig
|
||||
type ('a,'b) token
|
||||
|
|
|
|||
File diff suppressed because it is too large
Load Diff
|
|
@ -187,7 +187,8 @@ and embed_atPre_expressions (Variable (str,typ)) = (Variable (str,typ))
|
|||
(Let (var_name,var_type,embed_atPre_expressions rhs,rhs_type,embed_atPre_expressions in_e,in_type))
|
||||
| embed_atPre_expressions (Iterator (name,iter_vars,sterm,stype,body_e,body_type,res_type)) =
|
||||
(Iterator (name,iter_vars,embed_atPre_expressions sterm,stype,embed_atPre_expressions body_e,body_type,res_type))
|
||||
|
||||
| embed_atPre_expressions (Iterate (iter_vars,acc_var_name,acc_var_type,acc_var_term,sterm,stype,bterm,btype,res_type)) =
|
||||
(Iterate (iter_vars,acc_var_name,acc_var_type,acc_var_term,embed_atPre_expressions sterm,stype,embed_atPre_expressions bterm,btype,res_type))
|
||||
(* RETURN: OclTerm *)
|
||||
fun embed_bound_variable (str,typ) (Variable(s,t)) =
|
||||
let
|
||||
|
|
@ -220,6 +221,12 @@ fun embed_bound_variable (str,typ) (Variable(s,t)) =
|
|||
in
|
||||
(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))
|
||||
end
|
||||
| embed_bound_variable (s,typ) (Iterate (iter_vars,acc_name,acc_type,acc_term,sterm,stype,bterm,btype,res_type)) =
|
||||
let
|
||||
val _ = trace medium ("Bound variable '" ^ s ^ "' in 'Iterate': " ^ Ocl2String.ocl2string false (Iterate (iter_vars,acc_name,acc_type,acc_term,sterm,stype,bterm,btype,res_type)) ^ "\n")
|
||||
in
|
||||
(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))
|
||||
end
|
||||
| embed_bound_variable (s,typ) (Let (var_name,var_type,rhs,rhs_type,in_e,in_type)) =
|
||||
let
|
||||
val _ = trace zero ("Bound variable '" ^ s ^ "' in 'Let': " ^ Ocl2String.ocl2string false (Let (var_name,var_type,rhs,rhs_type,in_e,in_type)) ^ "\n")
|
||||
|
|
@ -353,10 +360,16 @@ check_for_self arg_list typ (AttributeCall (Variable("dummy_source",_),_,path,_)
|
|||
end
|
||||
| check_for_self arg_list typ (Iterator (name,iter_var,sterm,styp,expr,expr_typ,res_typ)) model =
|
||||
let
|
||||
val _ = trace zero ("check_for_self: complex OperationCall "^ "\n")
|
||||
val _ = trace zero ("check_for_self: Iterator "^ "\n")
|
||||
in
|
||||
(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))
|
||||
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 _ = trace zero ("check_for_self: Iterate "^ "\n")
|
||||
in
|
||||
(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))
|
||||
end
|
||||
| check_for_self arg_list typ (Let (str,ttyp,rhs_term,rhs_typ,in_term,in_typ)) model =
|
||||
let
|
||||
val self_rhs_term = check_for_self arg_list typ rhs_term model
|
||||
|
|
|
|||
|
|
@ -51,6 +51,8 @@ sig
|
|||
exception NotYetSupportedError of string
|
||||
exception WrongContextChecked of Context.context
|
||||
exception IterateError of string
|
||||
exception IterateAccumulatorTypeError of string
|
||||
exception IterateTypeMissMatch of string
|
||||
|
||||
val check_context_list : Context.context list -> Rep_Core.Classifier list -> Context.context option list
|
||||
val check_context : Context.context -> Rep_Core.Classifier list -> Context.context option
|
||||
|
|
@ -75,8 +77,6 @@ open Ext_Library
|
|||
type operation = Rep_Core.operation
|
||||
type attribute = Rep_Core.attribute
|
||||
|
||||
|
||||
|
||||
exception wrongCollectionLiteral of Rep_OclTerm.OclTerm * string
|
||||
exception CollectionRangeError of Rep_OclTerm.CollectionPart * string
|
||||
exception IteratorTypeMissMatch of Rep_OclTerm.OclTerm * string
|
||||
|
|
@ -87,6 +87,8 @@ exception WrongContextChecked of context
|
|||
exception AsSetError of (OclTerm * string list * int * (OclTerm * OclType) list * Classifier list)
|
||||
exception DesugaratorCall of (OclTerm * string list * int * (OclTerm * OclType) list * Classifier list)
|
||||
exception IterateError of string
|
||||
exception IterateAccumulatorTypeError of string
|
||||
exception IterateTypeMissMatch of string
|
||||
|
||||
(* RETURN: bool *)
|
||||
fun check_argument_type [] [] = true
|
||||
|
|
@ -440,48 +442,6 @@ let
|
|||
| NoCollectionTypeError typ => AsSet_desugarator rterm meth_path 0 rargs model
|
||||
)
|
||||
end
|
||||
end
|
||||
(* generic iterate: Iterate *)
|
||||
| resolve_OclTerm (Iterate (iter_vars,res_var_name,res_var_typ,res_var_term,sterm,_,body_expr,_,res_typ)) model =
|
||||
let
|
||||
val _ = trace low ("RESOLVE Iterte: iterate = " ^ res_var_name ^ "\n")
|
||||
|
||||
|
||||
(* resolve source *)
|
||||
val rsterm = resolve_OclTerm sterm model
|
||||
val rtyp = type_of_term rsterm
|
||||
val typ_of_iter = template_parameter rtyp
|
||||
|
||||
(* check type of iterate variables *)
|
||||
val class_list = List.map (fn (a,b) => class_of_type b model) iter_vars
|
||||
val typ_list = List.map type_of class_list
|
||||
|
||||
val list_conf = List.map (fn a => conforms_to a typ_of_iter model) typ_list
|
||||
in
|
||||
if (List.all (fn (a) => if (a) then true else false) list_conf)
|
||||
then
|
||||
let
|
||||
(* resolve res term *)
|
||||
val res_var_rterm = resolve_OclTerm res_var_term model
|
||||
val res_var_rtyp = type_of_term res_var_rterm
|
||||
(* embed 'iterate'-variable in body_expr term *)
|
||||
val embed_body = embed_bound_variables iter_vars body_expr
|
||||
(* resolve body_expr *)
|
||||
val rbody = resolve_OclTerm embed_body model
|
||||
val rbody_typ = type_of_term rbody
|
||||
in
|
||||
if (conforms_to res_var_rtyp res_var_typ model)
|
||||
then
|
||||
if (conforms_to rbody_typ res_var_typ model)
|
||||
then
|
||||
Iterate (iter_vars,res_var_name,res_var_typ,res_var_rterm,rsterm,rtyp,rbody,rbody_typ,res_var_typ)
|
||||
else
|
||||
raise IterateError ("Bodytermtyp (" ^ string_of_OclType rbody_typ ^") does not conform to result typ of expression (" ^ string_of_OclType res_var_typ ^ "\n")
|
||||
else
|
||||
raise IterateError ("Static type of result variable (" ^ string_of_OclType res_var_typ ^ ") does not conform to dynamic type result variable (" ^ string_of_OclType res_var_rtyp ^ ") \n")
|
||||
end
|
||||
else
|
||||
raise IterateError ("Type of iteratores [] doesn't conform to type of source (" ^ (string_of_OclType rtyp) ^ "\n")
|
||||
end
|
||||
(* Iterator *)
|
||||
| resolve_OclTerm (Iterator (name,iter_vars,source_term,_,expr,expr_typ,res_typ)) model =
|
||||
|
|
@ -541,6 +501,53 @@ end
|
|||
else
|
||||
raise IteratorTypeMissMatch (Iterator (name,iter_vars,source_term,DummyT,expr,expr_typ,res_typ),("Iterator variable doesn't conform to choosen set \n"))
|
||||
end
|
||||
| resolve_OclTerm (Iterate (iter_vars,acc_var_name,acc_var_type,acc_var_term,sterm,stype,bterm,btype,res_type)) model =
|
||||
let
|
||||
(* resolve source term, type *)
|
||||
val _ = trace medium ("RESOLVE Iterate: accumulator " ^ acc_var_name ^ "\n")
|
||||
val rterm = resolve_OclTerm sterm model
|
||||
val rtyp = type_of_term rterm
|
||||
val _ = trace medium ("res Iterate: source type " ^ string_of_OclType (type_of_term rterm) ^ "\n\n")
|
||||
(* get source classifier *)
|
||||
val source_class = get_classifier rterm model
|
||||
val _ = trace medium ("res Iterate: type of classifier: " ^ string_of_OclType (type_of source_class) ^ "\n")
|
||||
(* prefix types *)
|
||||
val prfx = (package_of_template_parameter (type_of source_class))
|
||||
val _ = trace medium ("res Iterate: Type prefixed ... \n")
|
||||
val piter_vars = List.map (fn (a,b) => (a,prefix_type prfx b)) iter_vars
|
||||
val piter_types = List.map (fn (a,b) => b) piter_vars
|
||||
val _ = trace medium ("res Iterate: first iter types: " ^ string_of_OclType (List.hd piter_types) ^ "\n")
|
||||
(* check if iterator types correspond to source type *)
|
||||
val static_iter_type = template_parameter (type_of (source_class))
|
||||
val _ = trace medium ("Length of iter_types: " ^ Int.toString (List.length piter_types) ^ "\n")
|
||||
val _ = trace medium ("parent of classifier: " ^ string_of_OclType (type_of_parent source_class) ^ "\n")
|
||||
val _ = trace medium ("\nstatic iter type : " ^ string_of_OclType static_iter_type ^ " \n")
|
||||
val _ = trace medium ("iter types: " ^ string_of_OclType (List.hd piter_types) ^ "\n")
|
||||
val h2 = List.map (fn a => conforms_to a static_iter_type model) (piter_types)
|
||||
val check = List.all (fn a => a=true) h2
|
||||
(* check if initial value of accumulator has correct type *)
|
||||
val racc_var_term = resolve_OclTerm acc_var_term model
|
||||
val racc_var_type = type_of_term racc_var_term
|
||||
in
|
||||
if (check) then
|
||||
if (racc_var_type = acc_var_type) then
|
||||
let
|
||||
val _ = trace medium ("res Iterate: types conforms \n")
|
||||
val bound_expr = embed_bound_variables piter_vars bterm
|
||||
val bound_expr2 = embed_bound_variables [(acc_var_name,acc_var_type)] bound_expr
|
||||
val _ = trace medium ("myres Iterate: term : " ^ Ocl2String.ocl2string false bound_expr2 ^ "\n")
|
||||
val rexpr = resolve_OclTerm bound_expr2 model
|
||||
val _ = trace medium (" manuel " ^ string_of_OclType (type_of_term rexpr) ^ "\n")
|
||||
val _ = trace medium (" ma " ^ string_of_OclType (Set(static_iter_type)) ^ "\n")
|
||||
val _ = trace medium ("res Iterate: \n\n\n")
|
||||
in
|
||||
Iterate(piter_vars,acc_var_name,racc_var_type,racc_var_term,rterm,rtyp,rexpr,type_of_term rexpr,racc_var_type)
|
||||
end
|
||||
else
|
||||
raise IterateAccumulatorTypeError ("Type of accumulator does not conform to type of expression of accumulator")
|
||||
else
|
||||
raise IterateTypeMissMatch ("Iterate variables doesn't conform to choosen set \n")
|
||||
end
|
||||
| resolve_OclTerm (CollectionLiteral ([],typ)) model =
|
||||
let
|
||||
val _ = trace medium ("RESOLVE CollectionLiteral\n")
|
||||
|
|
|
|||
Loading…
Reference in New Issue