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 *)
|
(* Iterate *)
|
||||||
(**************************************)
|
(**************************************)
|
||||||
(* Error *)
|
(* 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 *)
|
(* Iterator *)
|
||||||
(**************************************)
|
(**************************************)
|
||||||
|
@ -217,17 +225,17 @@ fun ocl2string show_types oclterm =
|
||||||
else (ocl2string show_types src)^"->"^iname^"("
|
else (ocl2string show_types src)^"->"^iname^"("
|
||||||
^(cs_list (map #1 vars))
|
^(cs_list (map #1 vars))
|
||||||
^"|"^(ocl2string show_types c)^")"
|
^"|"^(ocl2string show_types c)^")"
|
||||||
|
(*
|
||||||
(* OCL Collection *)
|
(* OCL Collection *)
|
||||||
(*
|
|
||||||
| Iterate (src,styp,["oclLib",classifier,"iterate"],args,Collection _) => OclIterate u C be e
|
| 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,"isUnique"],args,Collection _) => OclIsUnique u C be
|
||||||
| Iterate (src,styp,["oclLib",classifier,"one"],args,Collection _) => OclOne 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
|
| Iterate (src,styp,["oclLib",classifier,"any"],args,Collection _) => OclAny u C be
|
||||||
(* OCL OrderedSet *)
|
(* 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 *)
|
(* Error *)
|
||||||
(* | Iterator (s,_,_,_,_,_,_) => error ("error: unknown Iterator '"^(s)^"' in in ocl2string")
|
(* | Iterator (s,_,_,_,_,_,_) => error ("error: unknown Iterator '"^(s)^"' in in ocl2string") *)
|
||||||
*) (**************************************)
|
(**************************************)
|
||||||
(* Catch out *)
|
(* Catch out *)
|
||||||
(**************************************)
|
(**************************************)
|
||||||
(* Error *)
|
(* Error *)
|
||||||
|
|
|
@ -229,6 +229,18 @@ fun add_source (source,(AttributeCall (_, _, path, res_typ ))) =
|
||||||
| add_source (source, If (paras)) =
|
| add_source (source, If (paras)) =
|
||||||
(* If has no source *)
|
(* If has no source *)
|
||||||
If (paras)
|
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 *)
|
(* RETURN: OclTerm list *)
|
||||||
fun add_source_to_list source (h::tail) = (add_source (source,h))::tail
|
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))
|
(OperationWithType (prefix_expression ext_path sterm,stype,para_name,para_type,res_type))
|
||||||
| prefix_expression ext_path (CollectionLiteral (coll_part_list,typ)) =
|
| prefix_expression ext_path (CollectionLiteral (coll_part_list,typ)) =
|
||||||
(CollectionLiteral (List.map (prefix_collectionpart ext_path) 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 *)
|
(* RETURN: OclType *)
|
||||||
fun template_parameter typ =
|
fun template_parameter typ =
|
||||||
|
|
|
@ -262,7 +262,7 @@ exception NotYetSupported of string
|
||||||
| msg_operator_cs of OclTerm
|
| msg_operator_cs of OclTerm
|
||||||
| property_call_parameters_cs of (OclTerm * OclType) list
|
| property_call_parameters_cs of (OclTerm * OclType) list
|
||||||
| qualifiers of CollectionPart list
|
| qualifiers of CollectionPart list
|
||||||
| iterate_vars_cs
|
| iterate_vars_cs of (string * OclType) list
|
||||||
| initialized_variable_cs of (string * OclType * OclTerm)
|
| initialized_variable_cs of (string * OclType * OclTerm)
|
||||||
| actual_parameter_list_cs of (OclTerm * OclType) list
|
| actual_parameter_list_cs of (OclTerm * OclType) list
|
||||||
| actual_parameter_list_tail_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 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))
|
| 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 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 initialize_variable_cs VERTICAL_BAR expression PAREN_CLOSE ()
|
|
||||||
*)
|
*)
|
||||||
|
| 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 *)
|
(* 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 *)
|
(* RETURN: (string * OclType) list *)
|
||||||
iterator_vars_cs : formal_parameter_list_cs VERTICAL_BAR (formal_parameter_list_cs)
|
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) *)
|
(* RETURN: (string * OclType * OclTerm) *)
|
||||||
initialized_variable_list_tail_cs : COMMA initialized_variable_cs (initialized_variable_cs)
|
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)
|
initialized_variable_cs : formal_parameter_cs variable_initializer ((#1 formal_parameter_cs),(#2 formal_parameter_cs),variable_initializer)
|
||||||
|
|
||||||
(* RETURN: (string * OclType) *)
|
(* 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 =
|
signature OclParser_TOKENS =
|
||||||
sig
|
sig
|
||||||
type ('a,'b) token
|
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))
|
(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)) =
|
| 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))
|
(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 *)
|
(* RETURN: OclTerm *)
|
||||||
fun embed_bound_variable (str,typ) (Variable(s,t)) =
|
fun embed_bound_variable (str,typ) (Variable(s,t)) =
|
||||||
let
|
let
|
||||||
|
@ -220,6 +221,12 @@ fun embed_bound_variable (str,typ) (Variable(s,t)) =
|
||||||
in
|
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))
|
(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
|
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)) =
|
| embed_bound_variable (s,typ) (Let (var_name,var_type,rhs,rhs_type,in_e,in_type)) =
|
||||||
let
|
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")
|
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
|
end
|
||||||
| check_for_self arg_list typ (Iterator (name,iter_var,sterm,styp,expr,expr_typ,res_typ)) model =
|
| check_for_self arg_list typ (Iterator (name,iter_var,sterm,styp,expr,expr_typ,res_typ)) model =
|
||||||
let
|
let
|
||||||
val _ = trace zero ("check_for_self: complex OperationCall "^ "\n")
|
val _ = trace zero ("check_for_self: Iterator "^ "\n")
|
||||||
in
|
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))
|
(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
|
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 =
|
| check_for_self arg_list typ (Let (str,ttyp,rhs_term,rhs_typ,in_term,in_typ)) model =
|
||||||
let
|
let
|
||||||
val self_rhs_term = check_for_self arg_list typ rhs_term model
|
val self_rhs_term = check_for_self arg_list typ rhs_term model
|
||||||
|
|
|
@ -51,6 +51,8 @@ sig
|
||||||
exception NotYetSupportedError of string
|
exception NotYetSupportedError of string
|
||||||
exception WrongContextChecked of Context.context
|
exception WrongContextChecked of Context.context
|
||||||
exception IterateError of string
|
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_list : Context.context list -> Rep_Core.Classifier list -> Context.context option list
|
||||||
val check_context : Context.context -> Rep_Core.Classifier list -> Context.context option
|
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 operation = Rep_Core.operation
|
||||||
type attribute = Rep_Core.attribute
|
type attribute = Rep_Core.attribute
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
exception wrongCollectionLiteral of Rep_OclTerm.OclTerm * string
|
exception wrongCollectionLiteral of Rep_OclTerm.OclTerm * string
|
||||||
exception CollectionRangeError of Rep_OclTerm.CollectionPart * string
|
exception CollectionRangeError of Rep_OclTerm.CollectionPart * string
|
||||||
exception IteratorTypeMissMatch of Rep_OclTerm.OclTerm * 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 AsSetError of (OclTerm * string list * int * (OclTerm * OclType) list * Classifier list)
|
||||||
exception DesugaratorCall 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 IterateError of string
|
||||||
|
exception IterateAccumulatorTypeError of string
|
||||||
|
exception IterateTypeMissMatch of string
|
||||||
|
|
||||||
(* RETURN: bool *)
|
(* RETURN: bool *)
|
||||||
fun check_argument_type [] [] = true
|
fun check_argument_type [] [] = true
|
||||||
|
@ -440,48 +442,6 @@ let
|
||||||
| NoCollectionTypeError typ => AsSet_desugarator rterm meth_path 0 rargs model
|
| NoCollectionTypeError typ => AsSet_desugarator rterm meth_path 0 rargs model
|
||||||
)
|
)
|
||||||
end
|
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
|
end
|
||||||
(* Iterator *)
|
(* Iterator *)
|
||||||
| resolve_OclTerm (Iterator (name,iter_vars,source_term,_,expr,expr_typ,res_typ)) model =
|
| resolve_OclTerm (Iterator (name,iter_vars,source_term,_,expr,expr_typ,res_typ)) model =
|
||||||
|
@ -541,6 +501,53 @@ end
|
||||||
else
|
else
|
||||||
raise IteratorTypeMissMatch (Iterator (name,iter_vars,source_term,DummyT,expr,expr_typ,res_typ),("Iterator variable doesn't conform to choosen set \n"))
|
raise IteratorTypeMissMatch (Iterator (name,iter_vars,source_term,DummyT,expr,expr_typ,res_typ),("Iterator variable doesn't conform to choosen set \n"))
|
||||||
end
|
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 =
|
| resolve_OclTerm (CollectionLiteral ([],typ)) model =
|
||||||
let
|
let
|
||||||
val _ = trace medium ("RESOLVE CollectionLiteral\n")
|
val _ = trace medium ("RESOLVE CollectionLiteral\n")
|
||||||
|
|
Loading…
Reference in New Issue