git-svn-id: https://projects.brucker.ch/su4sml/svn/su4sml/trunk@7439 3260e6d1-4efc-4170-b0a7-36055960796d
This commit is contained in:
Manuel Krucker
parent
71729d90d3
commit
88f231cfbf
|
|
@ -152,7 +152,7 @@ fun curClassifierPackageToString env p2sfun = (case (#curClassifier env) of
|
|||
fun lookup env "classifier_name" = Rep_Core.short_name_of (curClassifier' env)
|
||||
| lookup env "classifier_package" = curClassifierPackageToString env Rep_OclType.string_of_path
|
||||
| lookup env "classifier_package_path" = curClassifierPackageToString env Rep_OclType.pathstring_of_path
|
||||
| lookup env "classifier_parent" = Rep_Core.short_parent_name_of (curClassifier' env)
|
||||
| lookup env "classifier_parent" = Rep_Core.parent_short_name_of (curClassifier' env)
|
||||
| lookup env "attribute_name" = #name (curAttribute' env)
|
||||
| lookup env "attribute_type" = oclType2Native (#attr_type (curAttribute' env))
|
||||
|
||||
|
|
|
|||
|
|
@ -399,8 +399,8 @@ op_constraint_stereotype_cs : PRE (PRE)
|
|||
|
||||
|
||||
(* RETURN: OclTerm *)
|
||||
collection_literal_exp_cs : collection_type_identifier_cs BRACE_OPEN BRACE_CLOSE (CollectionLiteral ([],dispatch_collection (collection_type_identifier_cs,DummyT)))
|
||||
| collection_type_identifier_cs BRACE_OPEN collection_literal_parts_cs BRACE_CLOSE (CollectionLiteral (collection_literal_parts_cs,dispatch_collection(collection_type_identifier_cs,DummyT)))
|
||||
collection_literal_exp_cs : collection_type_identifier_cs BRACE_OPEN BRACE_CLOSE (CollectionLiteral ([],create_set (collection_type_identifier_cs,DummyT)))
|
||||
| collection_type_identifier_cs BRACE_OPEN collection_literal_parts_cs BRACE_CLOSE (CollectionLiteral (collection_literal_parts_cs,create_set(collection_type_identifier_cs,DummyT)))
|
||||
|
||||
|
||||
(* RETURN: CollectionPart list *)
|
||||
|
|
@ -419,7 +419,7 @@ collection_range_cs : expression DBL_DOT expression (Coll
|
|||
|
||||
(* renamed to collection_type_specifier_cs from collection_type_cs *)
|
||||
(* RETURN: OclType *)
|
||||
collection_type_specifier_cs : collection_type_identifier_cs PAREN_OPEN type_specifier PAREN_CLOSE (dispatch_collection (collection_type_identifier_cs,type_specifier))
|
||||
collection_type_specifier_cs : collection_type_identifier_cs PAREN_OPEN type_specifier PAREN_CLOSE (create_set (collection_type_identifier_cs,type_specifier))
|
||||
|
||||
(* RETURN: string *)
|
||||
collection_type_identifier_cs: SET (SET)
|
||||
|
|
@ -616,7 +616,7 @@ property_call_exp_cs : path_name_cs (AttributeCall (Va
|
|||
| path_name_cs time_exp_cs property_call_parameters_cs (OperationCall (Variable ("dummy_source",DummyT),DummyT,path_name_cs@["atPre"],property_call_parameters_cs,DummyT))
|
||||
|
||||
(* NOT YET SUPPORTED
|
||||
| path_name_cs qualifiers (CollectionLiteral (qualifiers, dispatch_collection (List.last path_name_cs,qualifiers)))
|
||||
| path_name_cs qualifiers (CollectionLiteral (qualifiers, create_set (List.last path_name_cs,qualifiers)))
|
||||
| path_name_cs qualifiers time_exp_cs
|
||||
*)
|
||||
|
||||
|
|
@ -695,7 +695,7 @@ type_specifier: simple_type_specifier_cs
|
|||
*)
|
||||
|
||||
(* RETURN: OclType *)
|
||||
simple_type_specifier_cs : simple_name (path_to_type [simple_name])
|
||||
simple_type_specifier_cs : simple_name (type_of_path [simple_name])
|
||||
|
||||
|
||||
(* RETURN: (string * OclType * OclTerm) list *)
|
||||
|
|
|
|||
|
|
@ -1865,7 +1865,7 @@ collection_type_identifier_cs1) = collection_type_identifier_cs1 ()
|
|||
val BRACE_OPEN1 = BRACE_OPEN1 ()
|
||||
val BRACE_CLOSE1 = BRACE_CLOSE1 ()
|
||||
in (
|
||||
CollectionLiteral ([],dispatch_collection (collection_type_identifier_cs,DummyT))
|
||||
CollectionLiteral ([],create_set (collection_type_identifier_cs,DummyT))
|
||||
)
|
||||
end)
|
||||
in ( LrTable.NT 63, ( result, collection_type_identifier_cs1left,
|
||||
|
|
@ -1884,7 +1884,7 @@ collection_type_identifier_cs1) = collection_type_identifier_cs1 ()
|
|||
collection_literal_parts_cs1 ()
|
||||
val BRACE_CLOSE1 = BRACE_CLOSE1 ()
|
||||
in (
|
||||
CollectionLiteral (collection_literal_parts_cs,dispatch_collection(collection_type_identifier_cs,DummyT))
|
||||
CollectionLiteral (collection_literal_parts_cs,create_set(collection_type_identifier_cs,DummyT))
|
||||
)
|
||||
end)
|
||||
in ( LrTable.NT 63, ( result, collection_type_identifier_cs1left,
|
||||
|
|
@ -1972,9 +1972,7 @@ collection_type_identifier_cs1 ()
|
|||
val PAREN_OPEN1 = PAREN_OPEN1 ()
|
||||
val (type_specifier as type_specifier1) = type_specifier1 ()
|
||||
val PAREN_CLOSE1 = PAREN_CLOSE1 ()
|
||||
in (
|
||||
dispatch_collection (collection_type_identifier_cs,type_specifier))
|
||||
|
||||
in (create_set (collection_type_identifier_cs,type_specifier))
|
||||
end)
|
||||
in ( LrTable.NT 48, ( result, collection_type_identifier_cs1left,
|
||||
PAREN_CLOSE1right), rest671)
|
||||
|
|
@ -3238,7 +3236,7 @@ end
|
|||
, simple_name1right)) :: rest671)) => let val result =
|
||||
MlyValue.simple_type_specifier_cs (fn _ => let val (simple_name as
|
||||
simple_name1) = simple_name1 ()
|
||||
in (path_to_type [simple_name])
|
||||
in (type_of_path [simple_name])
|
||||
end)
|
||||
in ( LrTable.NT 52, ( result, simple_name1left, simple_name1right),
|
||||
rest671)
|
||||
|
|
|
|||
|
|
@ -294,10 +294,10 @@ and generate_variables (Literal (paras)) path meth_name model = Literal (paras)
|
|||
val classifier = class_of path (model,[])
|
||||
val _ = trace low "classifier found\n"
|
||||
val meth_list = operations_of classifier
|
||||
val meth = find_operation meth_name meth_list
|
||||
val meth = get_operation meth_name meth_list
|
||||
val _ = trace zero ("a result call resolved ..." ^ "\n")
|
||||
in
|
||||
(Variable ("result",(#result meth)))
|
||||
(Variable ("result",(#result (valOf(meth)))))
|
||||
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))
|
||||
|
|
|
|||
|
|
@ -122,7 +122,7 @@ fun FromSet_desugarator rterm path attr_or_meth rargs (model as (cls,assocs):Rep
|
|||
let
|
||||
(* check 'fromSet' *)
|
||||
val _ = trace low ("\n==> FromSet-desugarator: operation ... \n")
|
||||
val new_type = template_parameter (type_of_term rterm)
|
||||
val new_type = type_of_template_parameter (type_of_term rterm)
|
||||
val iterVar = (("anonIterVar_" ^ (varcounter.nextStr())),new_type)
|
||||
val class = class_of_term (Variable (iterVar)) model
|
||||
val ops = get_overloaded_methods class (List.last path) model
|
||||
|
|
@ -141,7 +141,7 @@ fun FromSet_desugarator rterm path attr_or_meth rargs (model as (cls,assocs):Rep
|
|||
let
|
||||
(* check 'fromSet' *)
|
||||
val _ = trace low ("\n==> FromSet-desugarator: attribute/assocend ... \n")
|
||||
val new_type = template_parameter (type_of_term rterm)
|
||||
val new_type = type_of_template_parameter (type_of_term rterm)
|
||||
val iterVar = (("anonIterVar_" ^ (varcounter.nextStr())),new_type)
|
||||
val class = class_of_term (Variable (iterVar)) model
|
||||
val attrs_or_assocs = get_overloaded_attrs_or_assocends class (List.last path) model
|
||||
|
|
@ -150,7 +150,7 @@ fun FromSet_desugarator rterm path attr_or_meth rargs (model as (cls,assocs):Rep
|
|||
then raise UpcastingError ("Attriubte '" ^ (List.last path) ^ "' does not exist ... \n")
|
||||
else
|
||||
let
|
||||
val insert_term = upcast_att_ae attrs_or_assocs (Variable iterVar) model
|
||||
val insert_term = upcast_att_aend attrs_or_assocs (Variable iterVar) model
|
||||
val it_type = type_of_term insert_term
|
||||
val _ = trace development ("association type " ^ string_of_OclType it_type ^ "\n")
|
||||
(* special case *)
|
||||
|
|
@ -161,7 +161,7 @@ fun FromSet_desugarator rterm path attr_or_meth rargs (model as (cls,assocs):Rep
|
|||
(* AttributeCall *)
|
||||
(x,SOME(shit),NONE) =>
|
||||
let
|
||||
val ret_type = replace_templ_para (type_of_term rterm) it_type
|
||||
val ret_type = substitute_templ_para (type_of_term rterm) it_type
|
||||
in
|
||||
Iterator ("collect",[iterVar],rterm,type_of_term rterm,insert_term,it_type,ret_type)
|
||||
end
|
||||
|
|
@ -170,13 +170,13 @@ fun FromSet_desugarator rterm path attr_or_meth rargs (model as (cls,assocs):Rep
|
|||
if (isColl_Type it_type)
|
||||
then
|
||||
let
|
||||
val ret_type = replace_templ_para (type_of_term rterm) (template_parameter it_type)
|
||||
val ret_type = substitute_templ_para (type_of_term rterm) (type_of_template_parameter it_type)
|
||||
in
|
||||
Iterator("collect",[iterVar],rterm,type_of_term rterm,insert_term,it_type,ret_type)
|
||||
end
|
||||
else
|
||||
let
|
||||
val ret_type = replace_templ_para (type_of_term rterm) it_type
|
||||
val ret_type = substitute_templ_para (type_of_term rterm) it_type
|
||||
in
|
||||
Iterator("collect",[iterVar],rterm,type_of_term rterm,insert_term,it_type,ret_type)
|
||||
end
|
||||
|
|
@ -217,7 +217,7 @@ fun AsSet_desugarator rterm path attr_or_meth rargs (model as (cls,assocs)) =
|
|||
then
|
||||
raise NoSuchAttributeError ("Attriubte '" ^ (List.last path) ^ "' does not exist ... \n")
|
||||
else
|
||||
upcast_att_ae attrs new_rterm model
|
||||
upcast_att_aend attrs new_rterm model
|
||||
end)
|
||||
|
||||
(* RETURN: OclTerm (OperationCall/AttributeCall) *)
|
||||
|
|
@ -319,19 +319,19 @@ and resolve_OclTerm (Literal (s,typ)) model =
|
|||
val _ = trace low ("\n==> 2-dim Inheritance check: ma attribute/assocend\n")
|
||||
val rtyp = type_of_term rterm
|
||||
val _ = trace low (string_of_OclType rtyp ^ "manu \n")
|
||||
val templ_type = template_parameter rtyp
|
||||
val templ_type = type_of_template_parameter rtyp
|
||||
val pclass = class_of_term (Variable ("x",templ_type)) model
|
||||
val _ = trace low ("manu 2")
|
||||
val ntempl_type = type_of_parent pclass
|
||||
val _ = trace low ("manu 3")
|
||||
val new_type = replace_templ_para rtyp ntempl_type
|
||||
val new_type = substitute_templ_para rtyp ntempl_type
|
||||
val new_class = class_of_term (Variable ("x",new_type)) model
|
||||
val attrs = get_overloaded_attrs_or_assocends new_class (List.last attr_path) model
|
||||
val _ = trace low ("parent type of term:" ^ string_of_OclType new_type ^ "\n")
|
||||
in
|
||||
if (List.length attrs = 0)
|
||||
then raise DesugaratorCall (rterm,attr_path,1,[],model)
|
||||
else upcast_att_ae attrs rterm model
|
||||
else upcast_att_aend attrs rterm model
|
||||
end
|
||||
)
|
||||
handle DesugaratorCall arg => desugarator (#1 arg) (#2 arg) (#3 arg) (#4 arg) (#5 arg)
|
||||
|
|
@ -357,7 +357,7 @@ let
|
|||
val class = class_of_term rterm model
|
||||
val prfx = package_of class
|
||||
val _ = trace low ("type of classifier: " ^ string_of_path prfx ^ "\n")
|
||||
val ctyp = prefix_type prfx (path_to_type [real_typ])
|
||||
val ctyp = prefix_type prfx (type_of_path [real_typ])
|
||||
val _ = trace low ("res OpCall: oclTypeOf 4:" ^ "... " ^ "\n")
|
||||
in
|
||||
OperationWithType (rterm,rtyp,"oclIsTypeOf",ctyp,Boolean)
|
||||
|
|
@ -375,7 +375,7 @@ let
|
|||
val class = class_of_term rterm model
|
||||
val prfx = package_of class
|
||||
val _ = trace low ("type of classifier: " ^ string_of_path prfx ^ "\n")
|
||||
val ctyp = prefix_type prfx (path_to_type [real_typ])
|
||||
val ctyp = prefix_type prfx (type_of_path [real_typ])
|
||||
val _ = trace low ("res OpCall: oclIsKindOf 4:" ^ "... " ^ "\n")
|
||||
in
|
||||
OperationWithType (rterm,rtyp,"oclIsKindOf",ctyp,Boolean)
|
||||
|
|
@ -393,7 +393,7 @@ let
|
|||
val class = class_of_term rterm model
|
||||
val prfx = package_of class
|
||||
val _ = trace low ("type of classifier: " ^ string_of_path prfx ^ "\n")
|
||||
val ctyp = prefix_type prfx (path_to_type [real_typ])
|
||||
val ctyp = prefix_type prfx (type_of_path [real_typ])
|
||||
val _ = trace low ("res OpCall: oclAsType 4:" ^ "... " ^ "\n")
|
||||
in
|
||||
OperationWithType (rterm,rtyp,"oclAsType",ctyp,ctyp)
|
||||
|
|
@ -434,11 +434,11 @@ let
|
|||
val _ = trace low ("\n==> 2-dim Inheritance check: attribute/assocend\n")
|
||||
val rtyp = type_of_term rterm
|
||||
val _ = trace low (string_of_OclType rtyp ^ "\n")
|
||||
val templ_type = template_parameter rtyp
|
||||
val templ_type = type_of_template_parameter rtyp
|
||||
val pclass = class_of_term (Variable ("x",templ_type)) model
|
||||
val ntempl_type = type_of_parent pclass
|
||||
val _ = trace low (string_of_OclType ntempl_type ^ "\n")
|
||||
val new_type = replace_templ_para rtyp ntempl_type
|
||||
val new_type = substitute_templ_para rtyp ntempl_type
|
||||
val new_class = class_of_term (Variable ("x",new_type)) model
|
||||
val ops = get_overloaded_methods new_class (List.last meth_path) model
|
||||
val _ = trace low ("parent type of term: " ^ string_of_OclType new_type ^ "\n")
|
||||
|
|
@ -471,7 +471,7 @@ end
|
|||
val piter_types = List.map (fn (a,b) => b) piter_vars
|
||||
val _ = trace low ("res Iter (" ^ name ^ "): 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 static_iter_type = type_of_template_parameter (type_of (source_class))
|
||||
val _ = trace low ("Length of iter_types: " ^ Int.toString (List.length piter_types) ^ "\n")
|
||||
val _ = trace low ("parent of classifier: " ^ string_of_OclType (type_of_parent source_class) ^ "\n")
|
||||
val _ = trace low ("\nstatic iter type : " ^ string_of_OclType static_iter_type ^ " \n")
|
||||
|
|
@ -504,7 +504,7 @@ end
|
|||
| "exists" =>
|
||||
Iterator (name,piter_vars,rterm,rtyp,rexpr,type_of_term rexpr,Boolean)
|
||||
| "collect" =>
|
||||
Iterator (name,piter_vars,rterm,rtyp,rexpr,type_of_term rexpr,flatten_type (replace_templ_para (rtyp) (type_of_term rexpr)))
|
||||
Iterator (name,piter_vars,rterm,rtyp,rexpr,type_of_term rexpr,flatten_type (substitute_templ_para (rtyp) (type_of_term rexpr)))
|
||||
| _ => raise NoSuchIteratorNameError (Iterator (name,iter_vars,source_term,DummyT,expr,expr_typ,res_typ),("No such Iterator ..."))
|
||||
)
|
||||
end
|
||||
|
|
@ -528,7 +528,7 @@ let
|
|||
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 static_iter_type = type_of_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")
|
||||
|
|
@ -571,7 +571,7 @@ let
|
|||
val typ = type_of_CollPart (List.hd r_coll_parts)
|
||||
in
|
||||
if (List.all (correct_type_for_CollLiteral typ) r_coll_parts) then
|
||||
(CollectionLiteral (r_coll_parts,replace_templ_para temp_typ typ))
|
||||
(CollectionLiteral (r_coll_parts,substitute_templ_para temp_typ typ))
|
||||
else
|
||||
raise (wrongCollectionLiteral ((CollectionLiteral (coll_parts,temp_typ)), ("not all Literals have type of Collection")))
|
||||
end
|
||||
|
|
@ -616,7 +616,7 @@ let
|
|||
val _ = trace high ("pre/post/body : " ^ Ocl2String.ocl2string false expr ^ "\n")
|
||||
val classifier = class_of_type (Classifier (path)) model
|
||||
val oper_list = operations_of classifier
|
||||
val oper = find_operation op_name oper_list
|
||||
val oper = valOf (get_operation op_name oper_list)
|
||||
val check1 = (op_sign = (#arguments oper))
|
||||
val check2 = (result_type = (#result oper))
|
||||
val _ = trace low ("check1 = " ^ Bool.toString check1 ^ ", check2 = " ^ Bool.toString check2 ^ "\n")
|
||||
|
|
@ -637,7 +637,7 @@ end
|
|||
val _ = trace low ( "classifier found ... " ^ "\n")
|
||||
val attr_list = attributes_of classifier
|
||||
val _ = trace low ( "attr_list found ... " ^ "\n")
|
||||
val attr = find_attribute (List.last path) attr_list
|
||||
val attr = valOf (get_attribute (List.last path) attr_list)
|
||||
val _ = trace low ( "attribute found ... " ^ "\n")
|
||||
in
|
||||
if (typ = #attr_type attr)
|
||||
|
|
|
|||
|
|
@ -161,14 +161,6 @@ val joinModel : transform_model -> transform_model -> transform_model
|
|||
*)
|
||||
val normalize_ext : transform_model -> transform_model
|
||||
|
||||
(*****************************************
|
||||
* CLASSIFIERS *
|
||||
*****************************************)
|
||||
(**
|
||||
* Ocl Classifier OclAny.
|
||||
*)
|
||||
val OclAnyC : Classifier
|
||||
|
||||
(**
|
||||
* TODO: Description
|
||||
*)
|
||||
|
|
@ -179,39 +171,6 @@ val normalize : association list -> Classifier -> Classifier
|
|||
*)
|
||||
val normalize_init : Classifier -> Classifier
|
||||
|
||||
(**
|
||||
* Returns the classifier of a given path.
|
||||
*)
|
||||
val class_of : Rep_OclType.Path -> transform_model -> Classifier
|
||||
|
||||
(**
|
||||
* Returns the classifier of a given type.
|
||||
*)
|
||||
val class_of_type : Rep_OclType.OclType -> transform_model -> Classifier
|
||||
|
||||
(**
|
||||
* Returns the classifier of a given term.
|
||||
*)
|
||||
val class_of_term : Rep_OclTerm.OclTerm -> transform_model -> Classifier
|
||||
|
||||
(**
|
||||
* Returns the classifier of the parent of a classifier.
|
||||
*)
|
||||
val class_of_parent : Classifier -> transform_model -> Classifier
|
||||
|
||||
(**
|
||||
* Returns all classifiers of a given package.
|
||||
*)
|
||||
val classes_of_package : Rep_OclType.Path -> transform_model -> Classifier list
|
||||
|
||||
(**
|
||||
* Returns the classifier of the parent of classifier.
|
||||
*)
|
||||
val parent_of : Classifier -> Classifier list -> Classifier
|
||||
|
||||
|
||||
|
||||
|
||||
(**
|
||||
* Update the thy_name of a classifier.
|
||||
*)
|
||||
|
|
@ -254,6 +213,64 @@ val topsort_cl : Classifier list -> Classifier list
|
|||
val connected_classifiers_of : association list -> Classifier -> Classifier list -> Classifier list
|
||||
|
||||
|
||||
(*****************************************
|
||||
* CLASSIFIERS *
|
||||
*****************************************)
|
||||
|
||||
(**
|
||||
* Ocl Classifier OclAny.
|
||||
*)
|
||||
val OclAnyC : Classifier
|
||||
|
||||
(**
|
||||
* Returns the classifier of a given path.
|
||||
*)
|
||||
val class_of : Rep_OclType.Path -> transform_model -> Classifier
|
||||
|
||||
(**
|
||||
* Returns the classifier of a given type.
|
||||
*)
|
||||
val class_of_type : Rep_OclType.OclType -> transform_model -> Classifier
|
||||
|
||||
(**
|
||||
* Returns the classifier of a given term.
|
||||
*)
|
||||
val class_of_term : Rep_OclTerm.OclTerm -> transform_model -> Classifier
|
||||
|
||||
(**
|
||||
* Returns the classifier of the parent of a classifier.
|
||||
*)
|
||||
val class_of_parent : Classifier -> transform_model -> Classifier
|
||||
|
||||
(**
|
||||
* Returns all classifiers of a given package.
|
||||
*)
|
||||
val classes_of_package : Rep_OclType.Path -> transform_model -> Classifier list
|
||||
|
||||
(**
|
||||
* Returns paths of the associations of a classifier.
|
||||
*)
|
||||
val associations_of : Classifier -> Rep_OclType.Path list
|
||||
|
||||
(**
|
||||
* Returns the invariants of an operation.
|
||||
*)
|
||||
val invariant_of : Classifier -> (string option * Rep_OclTerm.OclTerm) list
|
||||
|
||||
(**
|
||||
* Get the stereotypes of a classifier.
|
||||
*)
|
||||
val stereotypes_of : Classifier -> string list
|
||||
|
||||
(**
|
||||
* Is the classifier visible?
|
||||
*)
|
||||
val is_visible_cl : Classifier -> bool
|
||||
|
||||
(**
|
||||
* Visibility of classifier
|
||||
*)
|
||||
val visibility_of : Classifier -> Visibility
|
||||
|
||||
(*****************************************
|
||||
* TYPES *
|
||||
|
|
@ -280,10 +297,15 @@ val type_of_parents : Classifier -> transform_model -> Rep_OclType.OclTy
|
|||
*)
|
||||
val type_of_term : Rep_OclTerm.OclTerm -> Rep_OclType.OclType
|
||||
|
||||
(**
|
||||
* Returns the type of a given CollectionPart.
|
||||
*)
|
||||
val type_of_CollPart : Rep_OclTerm.CollectionPart -> Rep_OclType.OclType
|
||||
|
||||
(**
|
||||
* Returns the type of a given Path
|
||||
*)
|
||||
val path_to_type : Rep_OclType.Path -> Rep_OclType.OclType
|
||||
val type_of_path : Rep_OclType.Path -> Rep_OclType.OclType
|
||||
|
||||
(**
|
||||
* returns the type of the classifier this association end belongs to.
|
||||
|
|
@ -293,10 +315,10 @@ val path_to_type : Rep_OclType.Path -> Rep_OclType.OclType
|
|||
*)
|
||||
val type_of_aend : associationend -> Rep_OclType.OclType
|
||||
|
||||
(**
|
||||
* TODO: Description
|
||||
(**
|
||||
* Returns the type of the attribute.
|
||||
*)
|
||||
val aend_to_attr_type : associationend -> Rep_OclType.OclType
|
||||
val type_of_att : attribute -> Rep_OclType.OclType
|
||||
|
||||
(**
|
||||
* Returns the type of a not yet instantiate template
|
||||
|
|
@ -306,23 +328,18 @@ val type_of_template : Classifier -> Rep_OclType.OclType
|
|||
(**
|
||||
* Get type of template parameter.
|
||||
*)
|
||||
val template_parameter : Rep_OclType.OclType -> Rep_OclType.OclType
|
||||
val type_of_template_parameter : Rep_OclType.OclType -> Rep_OclType.OclType
|
||||
|
||||
(**
|
||||
* Replace the template parameter with another type.
|
||||
*)
|
||||
val replace_templ_para : Rep_OclType.OclType -> Rep_OclType.OclType -> Rep_OclType.OclType
|
||||
val substitute_templ_para : Rep_OclType.OclType -> Rep_OclType.OclType -> Rep_OclType.OclType
|
||||
|
||||
(**
|
||||
* Prefixes a type with a given package name.
|
||||
*)
|
||||
val prefix_type : string list -> Rep_OclType.OclType -> Rep_OclType.OclType
|
||||
|
||||
(**
|
||||
* Returns the type of a given CollectionPart.
|
||||
*)
|
||||
val type_of_CollPart : Rep_OclTerm.CollectionPart -> Rep_OclType.OclType
|
||||
|
||||
(**
|
||||
* Collections of Collections are flattened according to Ocl 2.0 Standard.
|
||||
*)
|
||||
|
|
@ -331,36 +348,78 @@ val flatten_type : Rep_OclType.OclType -> Rep_OclType.OclType
|
|||
(**
|
||||
* Dispatch a collection.
|
||||
*)
|
||||
val dispatch_collection : (string * Rep_OclType.OclType) -> Rep_OclType.OclType
|
||||
val create_set : (string * Rep_OclType.OclType) -> Rep_OclType.OclType
|
||||
|
||||
(**
|
||||
* Get the type if the associationend would be a attribute.
|
||||
*)
|
||||
val convert_aend_type : associationend -> Rep_OclType.OclType
|
||||
|
||||
(**
|
||||
* Are two types equal?
|
||||
*)
|
||||
val type_equals : Rep_OclType.OclType -> Rep_OclType.OclType -> bool
|
||||
|
||||
(**
|
||||
* Is first type conform to the second type?
|
||||
*)
|
||||
val conforms_to : Rep_OclType.OclType -> Rep_OclType.OclType -> transform_model -> bool
|
||||
|
||||
(**
|
||||
* OBSOLETE
|
||||
*)
|
||||
val correct_type_for_CollLiteral : Rep_OclType.OclType -> Rep_OclTerm.CollectionPart -> bool
|
||||
|
||||
(**
|
||||
* Type a collection type?
|
||||
*)
|
||||
val isColl_Type : Rep_OclType.OclType -> bool
|
||||
|
||||
(*****************************************
|
||||
* TERMS/EXPRESSIONS *
|
||||
*****************************************)
|
||||
|
||||
|
||||
(**
|
||||
* Upcast an OclTerm.
|
||||
*)
|
||||
val upcast : (Rep_OclTerm.OclTerm * Rep_OclType.OclType) -> Rep_OclTerm.OclTerm
|
||||
|
||||
(**
|
||||
* Interfere the types of the arguments of an operation according to
|
||||
* a given signature, if possible.
|
||||
*)
|
||||
val upcast_args : (string * Rep_OclType.OclType) list -> (Rep_OclTerm.OclTerm * Rep_OclType.OclType) list
|
||||
-> transform_model -> (Rep_OclTerm.OclTerm * Rep_OclType.OclType) list
|
||||
|
||||
(**
|
||||
* Upcast the types of an operation according to another operation, if possible.
|
||||
*)
|
||||
val upcast_op : (Classifier * operation) list -> Rep_OclTerm.OclTerm
|
||||
-> (Rep_OclTerm.OclTerm * Rep_OclType.OclType) list -> transform_model -> Rep_OclTerm.OclTerm
|
||||
(**
|
||||
*
|
||||
*)
|
||||
val upcastable_args : (string * Rep_OclType.OclType) list -> (Rep_OclTerm.OclTerm * Rep_OclType.OclType) list
|
||||
-> transform_model -> bool
|
||||
(**
|
||||
* Interfere the types of the arguments of an operation according to
|
||||
* a given signature, if possible.
|
||||
*)
|
||||
val upcast_args : (string * Rep_OclType.OclType) list -> (Rep_OclTerm.OclTerm * Rep_OclType.OclType) list
|
||||
-> transform_model -> (Rep_OclTerm.OclTerm * Rep_OclType.OclType) list
|
||||
(**
|
||||
*
|
||||
*)
|
||||
val upcast_type : Rep_OclType.OclType -> Rep_OclType.OclType -> transform_model -> Rep_OclType.OclType
|
||||
|
||||
(**
|
||||
* Upcast the types of an attribute to an other attribute, if possible.
|
||||
*)
|
||||
val upcast_att : (Classifier * attribute) -> Rep_OclTerm.OclTerm -> transform_model -> Rep_OclTerm.OclTerm option
|
||||
|
||||
(**
|
||||
* Upcast the types of an association to an other association, if possible.
|
||||
*)
|
||||
val upcast_aend : (Classifier * associationend) -> Rep_OclTerm.OclTerm -> transform_model -> Rep_OclTerm.OclTerm option
|
||||
|
||||
|
||||
(**
|
||||
* Upcast the types of an assoc/attribute to an other assoc/attribute, if possible.
|
||||
*)
|
||||
val upcast_att_ae : (Classifier * attribute option * associationend option) list
|
||||
val upcast_att_aend : (Classifier * attribute option * associationend option) list
|
||||
-> Rep_OclTerm.OclTerm -> transform_model -> Rep_OclTerm.OclTerm
|
||||
(**
|
||||
* Prefixes all types in a term with the
|
||||
|
|
@ -382,16 +441,7 @@ val prefix_collectionpart : string list -> Rep_OclTerm.CollectionPart -> Rep_O
|
|||
(**
|
||||
* Find an operation in a list of operations.
|
||||
*)
|
||||
val find_operation : string -> operation list -> operation
|
||||
|
||||
(**
|
||||
* Find an attribute in a list of attributes.
|
||||
*)
|
||||
val find_attribute : string -> attribute list -> attribute
|
||||
|
||||
|
||||
(** OBSOLETE **)
|
||||
val operations_of : Classifier -> operation list
|
||||
val get_operation : string -> operation list -> operation option
|
||||
(** Get the local operations of a classifier.*)
|
||||
val local_operations_of : Classifier -> operation list
|
||||
(** Get the redefined/refined operations of a classifier.*)
|
||||
|
|
@ -417,27 +467,18 @@ val query_operations_of : Classifier -> transform_model -> operation list
|
|||
(** Get all command operations of a classifier.*)
|
||||
val command_operations_of : Classifier -> transform_model -> operation list
|
||||
(** Get the local invariants of a classifier.*)
|
||||
|
||||
val local_invariants_of : Classifier -> (string option * Rep_OclTerm.OclTerm) list
|
||||
(** Get the inherited invarinats of a classifier.*)
|
||||
val inherited_invariants_of : Classifier -> transform_model -> (string option * Rep_OclTerm.OclTerm) list
|
||||
(** Get all invariants of a classifier.*)
|
||||
val all_invariants_of : Classifier -> transform_model -> (string option * Rep_OclTerm.OclTerm) list
|
||||
|
||||
(** OBSOLETE **)
|
||||
val operations_of : Classifier -> operation list
|
||||
(** OBSOLETE **)
|
||||
val get_overloaded_methods : Classifier -> string -> transform_model -> (Classifier * operation) list
|
||||
(** OBSOLETE **)
|
||||
val get_meth : Rep_OclTerm.OclTerm -> string -> (Rep_OclTerm.OclTerm * Rep_OclType.OclType) list
|
||||
-> transform_model -> Rep_OclTerm.OclTerm
|
||||
(** OBSOLETE **)
|
||||
(* val operation_of : Classifier list -> Rep_OclType.Path -> operation option *)
|
||||
|
||||
|
||||
|
||||
(** Test wheter the signatures are type consistent.*)
|
||||
val sig_conforms_to : (string * Rep_OclType.OclType) list -> (string * Rep_OclType.OclType) list -> transform_model -> bool
|
||||
|
||||
|
||||
(**
|
||||
* Returns the preconditions of an operation.
|
||||
*)
|
||||
|
|
@ -448,11 +489,6 @@ val precondition_of_op : operation -> (string option * Rep_OclTerm.OclTerm) lis
|
|||
*)
|
||||
val postcondition_of_op : operation -> (string option * Rep_OclTerm.OclTerm) list
|
||||
|
||||
(**
|
||||
* Returns the invariants of an operation.
|
||||
*)
|
||||
val invariant_of : Classifier -> (string option * Rep_OclTerm.OclTerm) list
|
||||
|
||||
(**
|
||||
* Returns the body of an operation.
|
||||
*)
|
||||
|
|
@ -473,6 +509,11 @@ val result_of_op : operation -> Rep_OclType.OclType
|
|||
*)
|
||||
val name_of_op : operation -> string
|
||||
|
||||
(**
|
||||
* Is the operation visible?
|
||||
*)
|
||||
val is_visible_op : operation -> bool
|
||||
|
||||
(**
|
||||
* TODO: Description
|
||||
*)
|
||||
|
|
@ -491,31 +532,32 @@ val update_postcondition : (string option * Rep_OclTerm.OclTerm) list ->
|
|||
operation -> operation
|
||||
|
||||
(*****************************************
|
||||
* SIGNATURES *
|
||||
* ATTRIBUTES *
|
||||
*****************************************)
|
||||
|
||||
(**
|
||||
* Prefixes all types in the signature with a
|
||||
* given string list.
|
||||
* Find an attribute in a list of attributes.
|
||||
*)
|
||||
val prefix_signature : string list -> (string * Rep_OclType.OclType) list -> (string * Rep_OclType.OclType) list
|
||||
|
||||
|
||||
|
||||
(*****************************************
|
||||
* attribute *
|
||||
*****************************************)
|
||||
val get_attribute : string -> attribute list -> attribute option
|
||||
(** OBSOLETE **)
|
||||
val attributes_of : Classifier -> attribute list
|
||||
|
||||
(** OBSOLETE **)
|
||||
val get_overloaded_attrs_or_assocends : Classifier -> string -> transform_model
|
||||
-> (Classifier * attribute option * associationend option) list
|
||||
(** OBSOLETE **)
|
||||
val get_attr_or_assoc : Rep_OclTerm.OclTerm -> string -> transform_model -> Rep_OclTerm.OclTerm
|
||||
(**
|
||||
* convert an associationend into an attribute.
|
||||
*)
|
||||
val convert_aend : string -> associationend -> attribute
|
||||
|
||||
(**
|
||||
* Is the attribute visible?
|
||||
*)
|
||||
val is_visible_attr : attribute -> bool
|
||||
|
||||
(*****************************************
|
||||
* RETURN associationend *
|
||||
* ASSOCIATIONENDS *
|
||||
*****************************************)
|
||||
|
||||
(**
|
||||
|
|
@ -544,61 +586,35 @@ val incomingAendsOfAssociation: Rep_OclType.OclType -> association list ->
|
|||
Rep_OclType.Path -> associationend list
|
||||
|
||||
(*****************************************
|
||||
* RETURN association *
|
||||
*****************************************)
|
||||
|
||||
|
||||
(*****************************************
|
||||
* RETURN Path/string *
|
||||
* PARENTS [ OK ] *
|
||||
*****************************************)
|
||||
|
||||
(**
|
||||
* Returns the name of the classifier.
|
||||
*)
|
||||
val name_of : Classifier -> Rep_OclType.Path
|
||||
* Returns the classifier of the parent of classifier.
|
||||
*)
|
||||
val parent_of : Classifier -> Classifier list -> Classifier
|
||||
|
||||
(**
|
||||
* Returns the thy_name of a classifer.
|
||||
(**
|
||||
* Returns all parents of a classifier.
|
||||
*)
|
||||
val thy_name_of : Classifier -> string
|
||||
val parents_of : Classifier -> Classifier list -> Rep_OclType.Path list
|
||||
|
||||
(**
|
||||
* Returns one of the parents from the classifier.
|
||||
*)
|
||||
val parent_name_of : Classifier -> Rep_OclType.Path
|
||||
|
||||
(**
|
||||
* Returns the name of the package.
|
||||
*)
|
||||
val package_of : Classifier -> Rep_OclType.Path
|
||||
|
||||
(**
|
||||
* Returns the name of the package from the
|
||||
* parent class.
|
||||
*)
|
||||
val parent_package_of : Classifier -> Rep_OclType.Path
|
||||
|
||||
(**
|
||||
* Returns the package name of the template parameter.
|
||||
*)
|
||||
val package_of_template_parameter : Rep_OclType.OclType -> string list
|
||||
|
||||
(**
|
||||
* Returns the name of the class without the first package part.
|
||||
*)
|
||||
val real_path : Rep_OclType.Path -> Rep_OclType.Path
|
||||
|
||||
(**
|
||||
* Returns the last part (last string in path) of
|
||||
* the name of the classifier.
|
||||
*)
|
||||
val short_name_of : Classifier -> string
|
||||
|
||||
(**
|
||||
* Returns the last part (last string in path) of the name
|
||||
* of the parent of the classifier.
|
||||
*)
|
||||
val short_parent_name_of : Classifier -> string
|
||||
val parent_short_name_of : Classifier -> string
|
||||
|
||||
(**
|
||||
* Returns the types of the interfaces from
|
||||
|
|
@ -612,10 +628,51 @@ val parent_interfaces_of : Classifier -> Rep_OclType.OclType list
|
|||
*)
|
||||
val parent_interface_names_of : Classifier -> Rep_OclType.Path list
|
||||
|
||||
(*****************************************
|
||||
* SIGNATURES *
|
||||
*****************************************)
|
||||
|
||||
(**
|
||||
* Returns paths of the associations of a classifier.
|
||||
* Prefixes all types in the signature with a
|
||||
* given string list.
|
||||
*)
|
||||
val associations_of : Classifier -> Rep_OclType.Path list
|
||||
val prefix_signature : string list -> (string * Rep_OclType.OclType) list -> (string * Rep_OclType.OclType) list
|
||||
|
||||
(**
|
||||
* Test wheter the signatures are type consistent.
|
||||
*)
|
||||
val sig_conforms_to : (string * Rep_OclType.OclType) list -> (string * Rep_OclType.OclType) list -> transform_model -> bool
|
||||
|
||||
|
||||
(*****************************************
|
||||
* RETURN Path/string *
|
||||
*****************************************)
|
||||
|
||||
(**
|
||||
* Returns the name of the classifier.
|
||||
*)
|
||||
val name_of : Classifier -> Rep_OclType.Path
|
||||
|
||||
(**
|
||||
* Returns the last part (last string in path) of
|
||||
* the name of the classifier.
|
||||
*)
|
||||
val short_name_of : Classifier -> string
|
||||
|
||||
(**
|
||||
* Returns the thy_name of a classifer.
|
||||
*)
|
||||
val thy_name_of : Classifier -> string
|
||||
|
||||
(**
|
||||
* Returns the name of the package.
|
||||
*)
|
||||
val package_of : Classifier -> Rep_OclType.Path
|
||||
|
||||
(**
|
||||
* Returns the package name of the template parameter.
|
||||
*)
|
||||
val package_of_template_parameter : Rep_OclType.OclType -> string list
|
||||
|
||||
(**
|
||||
* Path of the association.
|
||||
|
|
@ -663,11 +720,6 @@ val path_of_aend: associationend -> Rep_OclType.Path
|
|||
*)
|
||||
val role_of_aend : associationend -> string
|
||||
|
||||
(**
|
||||
* Get the stereotypes of a classifier.
|
||||
*)
|
||||
val stereotypes_of : Classifier -> string list
|
||||
|
||||
(**
|
||||
* Convert Path(string list) into a string.
|
||||
*)
|
||||
|
|
@ -678,11 +730,6 @@ val string_of_path : Rep_OclType.Path -> string
|
|||
*)
|
||||
val short_name_of_path : Rep_OclType.Path -> string
|
||||
|
||||
(**
|
||||
* Returns all parents of a classifier.
|
||||
*)
|
||||
val parents_of : Classifier -> Classifier list -> Rep_OclType.Path list
|
||||
|
||||
|
||||
(*****************************************
|
||||
* RETURN activity_graphs *
|
||||
|
|
@ -693,61 +740,12 @@ val parents_of : Classifier -> Classifier list -> Rep_OclType.Path list
|
|||
*)
|
||||
val activity_graphs_of: Classifier -> Rep_ActivityGraph.ActivityGraph list
|
||||
|
||||
(*****************************************
|
||||
* RETURN bool *
|
||||
*****************************************)
|
||||
(**
|
||||
* Are two types equal?
|
||||
*)
|
||||
val type_equals : Rep_OclType.OclType -> Rep_OclType.OclType -> bool
|
||||
|
||||
(**
|
||||
* Type a collection type?
|
||||
*)
|
||||
val isColl_Type : Rep_OclType.OclType -> bool
|
||||
(**
|
||||
* Is the classifier visible?
|
||||
*)
|
||||
val is_visible_cl : Classifier -> bool
|
||||
(**
|
||||
* Is the operation visible?
|
||||
*)
|
||||
val is_visible_op : operation -> bool
|
||||
(**
|
||||
* Is the attribute visible?
|
||||
*)
|
||||
val is_visible_attr : attribute -> bool
|
||||
(**
|
||||
* Is first type conform to the second type?
|
||||
*)
|
||||
val conforms_to : Rep_OclType.OclType -> Rep_OclType.OclType -> transform_model -> bool
|
||||
|
||||
(**
|
||||
* Is type a collection type?
|
||||
*)
|
||||
|
||||
(**
|
||||
* OBSOLETE
|
||||
*)
|
||||
val correct_type_for_CollLiteral : Rep_OclType.OclType -> Rep_OclTerm.CollectionPart -> bool
|
||||
|
||||
(**
|
||||
* Are the (first args) arguments of the an operation conform to another operations (second args)?
|
||||
*)
|
||||
val args_upcastable : (string * Rep_OclType.OclType) list -> (Rep_OclTerm.OclTerm * Rep_OclType.OclType) list -> transform_model -> bool
|
||||
|
||||
|
||||
(** update model **)
|
||||
|
||||
|
||||
(* visibility *)
|
||||
val visibility_of : Classifier -> Visibility
|
||||
|
||||
exception InvalidArguments of string
|
||||
exception TemplateError of string
|
||||
exception TemplateInstantiationError of string
|
||||
exception GetClassifierError of string
|
||||
exception UpcastingError of string
|
||||
exception OperationNotFoundError of string
|
||||
exception NoParentForDatatype of string
|
||||
exception NoModelReferenced of string
|
||||
exception NoCollectionTypeError of Rep_OclType.OclType
|
||||
|
|
@ -875,7 +873,7 @@ exception UpcastingError of string
|
|||
exception NoParentForDatatype of string
|
||||
exception NoModelReferenced of string
|
||||
exception NoCollectionTypeError of Rep_OclType.OclType
|
||||
|
||||
exception OperationNotFoundError of string
|
||||
|
||||
val OclLibPackage = "oclLib"
|
||||
val OclAnyC = Class{name=Rep_OclType.OclAny,parent=NONE,attributes=[],
|
||||
|
|
@ -938,15 +936,15 @@ fun result_of_op ({result,...}:operation) = result
|
|||
|
||||
fun arguments_of_op ({arguments,...}:operation) = arguments
|
||||
|
||||
fun path_to_type ["Integer"] = Integer
|
||||
| path_to_type ["Boolean"] = Boolean
|
||||
| path_to_type ["Real"] = Real
|
||||
| path_to_type ["OclAny"] = OclAny
|
||||
| path_to_type ["DummyT"] = DummyT
|
||||
| path_to_type ["String"] = String
|
||||
| path_to_type ["OclVoid"] = OclVoid
|
||||
| path_to_type (("oclLib")::tail) = path_to_type tail
|
||||
| path_to_type [set] =
|
||||
fun type_of_path ["Integer"] = Integer
|
||||
| type_of_path ["Boolean"] = Boolean
|
||||
| type_of_path ["Real"] = Real
|
||||
| type_of_path ["OclAny"] = OclAny
|
||||
| type_of_path ["DummyT"] = DummyT
|
||||
| type_of_path ["String"] = String
|
||||
| type_of_path ["OclVoid"] = OclVoid
|
||||
| type_of_path (("oclLib")::tail) = type_of_path tail
|
||||
| type_of_path [set] =
|
||||
if (List.exists (fn a => if (a = (#"(")) then true else false) (String.explode set)) then
|
||||
(* set *)
|
||||
let
|
||||
|
|
@ -968,22 +966,20 @@ fun path_to_type ["Integer"] = Integer
|
|||
val _ = TextIO.output(TextIO.stdOut,"tail "^ (String.implode tail) ^ "\n")
|
||||
|
||||
in
|
||||
string_to_cons (String.implode cons) (path_to_type ([String.implode tail]))
|
||||
string_to_cons (String.implode cons) (type_of_path ([String.implode tail]))
|
||||
end
|
||||
else
|
||||
Classifier ([set])
|
||||
| path_to_type list = Classifier (list)
|
||||
| type_of_path list = Classifier (list)
|
||||
|
||||
fun local_operations_of (Class{operations,...}) = operations
|
||||
| local_operations_of (AssociationClass{operations,...}) = operations
|
||||
| local_operations_of (Interface{operations,...}) = operations
|
||||
| local_operations_of (Enumeration{operations,...}) = operations
|
||||
| local_operations_of (Primitive{operations,...}) = operations
|
||||
| local_operations_of (Template{parameter,classifier}) = raise OperationNotFoundError ("..._operations_of a template not possible.\n")
|
||||
|
||||
fun operations_of (Class{operations,...}) = operations
|
||||
| operations_of (AssociationClass{operations,...}) = operations
|
||||
| operations_of (Interface{operations,...}) = operations
|
||||
| operations_of (Enumeration{operations,...}) = operations
|
||||
| operations_of (Primitive{operations,...}) = operations
|
||||
| operations_of (Template{parameter,classifier}) = operations_of classifier
|
||||
|
||||
fun local_operations_of (class:Classifier) = operations_of class
|
||||
|
||||
fun operations_of class = local_operations_of class
|
||||
|
||||
fun class_of_term source (c:Classifier list, a:association list) =
|
||||
let
|
||||
|
|
@ -1150,7 +1146,7 @@ fun class_of (name:Path) (model as (clist,alist)) =
|
|||
val _ = trace low ("top level package: " ^ (List.hd (name)) ^ "\n")
|
||||
val _ = trace low ("remaining package: " ^ (String.concat (List.tl name)) ^ "\n")
|
||||
in
|
||||
class_of_term (Variable("x",path_to_type name)) model
|
||||
class_of_term (Variable("x",type_of_path name)) model
|
||||
end
|
||||
|
||||
and class_of_type (typ:OclType) (model:transform_model) =
|
||||
|
|
@ -1349,7 +1345,7 @@ fun inherited_operations_of class (model as (clist,alist)) =
|
|||
let
|
||||
val parents = parents_of class (#1 model)
|
||||
val _ = trace 50 ("inh ops 2\n")
|
||||
val c_parents = List.map (fn a => class_of_type (path_to_type a) model) parents
|
||||
val c_parents = List.map (fn a => class_of_type (type_of_path a) model) parents
|
||||
val _ = trace 50 ("inh ops 3\n")
|
||||
val ops_of_par = (List.map (operations_of) c_parents)
|
||||
val _ = trace 50 ("inh ops 4\n")
|
||||
|
|
@ -1448,7 +1444,7 @@ fun command_operations_of class (model:transform_model) =
|
|||
|
||||
|
||||
(* convert an association end into the corresponding collection type *)
|
||||
fun aend_to_attr_type ({name,aend_type,multiplicity,
|
||||
fun convert_aend_type ({name,aend_type,multiplicity,
|
||||
ordered,visibility,init}:associationend) =
|
||||
(case multiplicity of
|
||||
[(0,1)] => aend_type
|
||||
|
|
@ -1457,9 +1453,9 @@ fun aend_to_attr_type ({name,aend_type,multiplicity,
|
|||
else Rep_OclType.Set aend_type)
|
||||
|
||||
|
||||
fun aend_to_attr (cls_name:string) (aend:associationend):attribute =
|
||||
fun convert_aend (cls_name:string) (aend:associationend):attribute =
|
||||
{name = List.last (#name aend),
|
||||
attr_type = aend_to_attr_type aend,
|
||||
attr_type = convert_aend_type aend,
|
||||
visibility = #visibility aend,
|
||||
scope = XMI.InstanceScope,
|
||||
stereotypes = nil,
|
||||
|
|
@ -1471,7 +1467,7 @@ fun aend_to_attr (cls_name:string) (aend:associationend):attribute =
|
|||
(* size > lowerBound and size < upperBound ) *)
|
||||
fun range_to_inv cls_name aend (a,b) =
|
||||
let val cls = Rep_OclType.Classifier cls_name
|
||||
val attr_type = aend_to_attr_type aend
|
||||
val attr_type = convert_aend_type aend
|
||||
val attr_name = cls_name@[List.last (#name aend)]
|
||||
val literal_a = Rep_OclTerm.Literal (Int.toString a, Rep_OclType.Integer)
|
||||
val literal_b = Rep_OclTerm.Literal (Int.toString b, Rep_OclType.Integer)
|
||||
|
|
@ -1513,14 +1509,14 @@ fun short_name_of_path p = (hd o rev) p
|
|||
|
||||
fun path_of_aend ({name,aend_type,...}:associationend) = name
|
||||
|
||||
fun replace_templ_para (Collection(tt)) t = Collection (t)
|
||||
| replace_templ_para (Set (tt)) t = Set (t)
|
||||
| replace_templ_para (OrderedSet (tt)) t = OrderedSet (t)
|
||||
| replace_templ_para (Sequence (tt)) t = Sequence (t)
|
||||
| replace_templ_para (Bag (tt)) t = Bag (t)
|
||||
| replace_templ_para t1 t2 = raise TemplateError ("Not possible to replace template parameter of a basic type. Type is: " ^ string_of_OclType t1 ^ " \n")
|
||||
fun substitute_templ_para (Collection(tt)) t = Collection (t)
|
||||
| substitute_templ_para (Set (tt)) t = Set (t)
|
||||
| substitute_templ_para (OrderedSet (tt)) t = OrderedSet (t)
|
||||
| substitute_templ_para (Sequence (tt)) t = Sequence (t)
|
||||
| substitute_templ_para (Bag (tt)) t = Bag (t)
|
||||
| substitute_templ_para t1 t2 = raise TemplateError ("Not possible to replace template parameter of a basic type. Type is: " ^ string_of_OclType t1 ^ " \n")
|
||||
|
||||
fun template_parameter typ =
|
||||
fun type_of_template_parameter typ =
|
||||
case typ of
|
||||
Set(t) => t
|
||||
| Sequence(t) => t
|
||||
|
|
@ -1583,7 +1579,7 @@ fun multiplicity_constraint cls_name (aend:associationend) =
|
|||
[(0,1)] => []
|
||||
| [(1,1)] => let
|
||||
val attr_name = cls_name@[List.last (#name aend)]
|
||||
val attr_type = aend_to_attr_type aend
|
||||
val attr_type = convert_aend_type aend
|
||||
val cls = Rep_OclType.Classifier cls_name
|
||||
val self = Rep_OclTerm.Variable ("self",cls)
|
||||
val attribute = Rep_OclTerm.AttributeCall (self,cls,
|
||||
|
|
@ -1623,6 +1619,8 @@ fun association_of_aend ({name,aend_type,...}:associationend) =
|
|||
|
||||
fun type_of_aend ({name,aend_type,...}:associationend) = aend_type
|
||||
|
||||
fun type_of_att ({name,attr_type,...}:attribute) = attr_type
|
||||
|
||||
fun name_of_aend ({name,aend_type,...}:associationend) =
|
||||
short_name_of_path name
|
||||
|
||||
|
|
@ -1633,7 +1631,6 @@ fun associations_of (Class{name,associations,...}) = associations
|
|||
associations
|
||||
| associations_of (Primitive{name,associations,...}) = associations
|
||||
|
||||
|
||||
fun oppositeAendsOfAssociation name allAssociations associationPath =
|
||||
let
|
||||
val [association] = List.filter (fn assoc => path_of_association assoc =
|
||||
|
|
@ -1757,7 +1754,7 @@ fun normalize (all_associations:association list)
|
|||
in
|
||||
Class {name = name,
|
||||
parent = parent,
|
||||
attributes = append (map (aend_to_attr (List.last(path_of_OclType
|
||||
attributes = append (map (convert_aend (List.last(path_of_OclType
|
||||
name)))
|
||||
(associationends_of all_associations C))
|
||||
attributes,
|
||||
|
|
@ -1792,7 +1789,7 @@ fun normalize (all_associations:association list)
|
|||
AssociationClass {
|
||||
name = name,
|
||||
parent = parent,
|
||||
attributes = append (map (aend_to_attr (List.last (path_of_OclType
|
||||
attributes = append (map (convert_aend (List.last (path_of_OclType
|
||||
name)))
|
||||
(associationends_of all_associations AC))
|
||||
attributes,
|
||||
|
|
@ -2187,9 +2184,9 @@ fun package_of (Class{name,...}) =
|
|||
fun classes_of_package pkg (model as (clist,alist)) =
|
||||
List.filter (fn a => package_of a = pkg) clist
|
||||
|
||||
fun short_parent_name_of C =
|
||||
fun parent_short_name_of C =
|
||||
(case (parent_name_of C) of
|
||||
[] => error "in Rep.short_parent_name_of: empty type"
|
||||
[] => error "in Rep.parent_short_name_of: empty type"
|
||||
| p => (hd o rev) p)
|
||||
|
||||
fun parent_package_of (Class{parent,...}) =
|
||||
|
|
@ -2548,9 +2545,9 @@ fun isColl_Type (Set(x)) = true
|
|||
| isColl_Type (Collection(x)) = true
|
||||
| isColl_Type _ = false
|
||||
|
||||
fun find_operation op_name (list:operation list) = List.hd (List.filter (fn a => (#name a) = op_name) list)
|
||||
fun get_operation op_name (list:operation list) = List.find (fn a => (#name a) = op_name) list
|
||||
|
||||
fun find_attribute att_name (list:attribute list) = List.hd (List.filter (fn a => (#name a) = att_name) list)
|
||||
fun get_attribute att_name (list:attribute list) = List.find (fn a => (#name a) = att_name) list
|
||||
|
||||
fun type_of_parent (Class {parent,...}) =
|
||||
let
|
||||
|
|
@ -2658,17 +2655,13 @@ fun type_of_template (T as Template{classifier,parameter}) =
|
|||
fun parent_of C cl = (class_of (parent_name_of C) (cl,[]))
|
||||
|
||||
|
||||
(*
|
||||
fun operation_of cl fq_name =
|
||||
fun get_op cl op_name (model:transform_model) =
|
||||
let
|
||||
val classname = (rev o tl o rev) fq_name
|
||||
val operations = local_operations_of (class_of classname (cl,[]))
|
||||
val name = (hd o rev) fq_name
|
||||
val ops = all_operations_of cl model
|
||||
in
|
||||
SOME(hd (filter (fn a => if ((name_of_op a) = name)
|
||||
then true else false ) operations ))
|
||||
List.find (fn a => op_name = name_of_op a) ops
|
||||
|
||||
end
|
||||
*)
|
||||
|
||||
fun connected_classifiers_of (all_associations:association list)
|
||||
(C as Class {attributes,associations,...})
|
||||
|
|
@ -2714,8 +2707,8 @@ fun connected_classifiers_of (all_associations:association list)
|
|||
|
||||
|
||||
|
||||
fun args_upcastable [] [] model = true
|
||||
| args_upcastable ((str,typ)::tail) ((term,ttyp)::args) model =
|
||||
fun upcastable_args [] [] model = true
|
||||
| upcastable_args ((str,typ)::tail) ((term,ttyp)::args) model =
|
||||
let
|
||||
val _ = trace low ("must conform to: " ^ (string_of_OclType typ) ^ "\n")
|
||||
in
|
||||
|
|
@ -2725,8 +2718,8 @@ fun args_upcastable [] [] model = true
|
|||
false
|
||||
end
|
||||
(* not same nuber of arguments *)
|
||||
| args_upcastable [x] list model = false
|
||||
| args_upcastable list [x] model = false
|
||||
| upcastable_args [x] list model = false
|
||||
| upcastable_args list [x] model = false
|
||||
|
||||
(* RETURN: (OclTerm * OclType) list *)
|
||||
fun upcast_args [] [] model = []
|
||||
|
|
@ -2744,7 +2737,7 @@ fun upcast_args [] [] model = []
|
|||
end
|
||||
|
||||
(* RETURN: OclType *)
|
||||
fun upcast_res_type t1 t2 model =
|
||||
fun upcast_type t1 t2 model =
|
||||
if (conforms_to t1 t2 model)
|
||||
then t2
|
||||
else raise UpcastingError ("Result type does not conform \n")
|
||||
|
|
@ -2761,7 +2754,7 @@ fun upcast_op [] source args model =
|
|||
let
|
||||
val _ = trace low ("\nInterfere method : name : '" ^ name_of_op meth ^ "'\n")
|
||||
val check_source = conforms_to (type_of_term source) (type_of class) model
|
||||
val check_args = args_upcastable (#arguments meth) args model
|
||||
val check_args = upcastable_args (#arguments meth) args model
|
||||
val _ = trace low ("Upcastable ? : Source conforms : " ^ Bool.toString check_source ^ " Args conforms : " ^ Bool.toString check_args ^ "\n")
|
||||
val _ = trace low ("Return type of method : " ^ string_of_OclType (result_of_op meth) ^ "\n\n")
|
||||
in
|
||||
|
|
@ -2786,34 +2779,34 @@ fun upcast_att (class,attr:attribute) source (model:transform_model) =
|
|||
end
|
||||
|
||||
|
||||
fun upcast_ae (class,assocend:associationend) source (model:transform_model) =
|
||||
fun upcast_aend (class,assocend:associationend) source (model:transform_model) =
|
||||
let
|
||||
val check_source = conforms_to (type_of_term source) (type_of class) model
|
||||
val _ = trace low ("Interfere assocend: check_source " ^ Bool.toString check_source ^ "\n")
|
||||
val _ = trace low ("type of assoc " ^ string_of_OclType (aend_to_attr_type assocend) ^ "\n")
|
||||
val _ = trace low ("type of assoc " ^ string_of_OclType (convert_aend_type assocend) ^ "\n")
|
||||
in
|
||||
if check_source then
|
||||
(* billk_tag *)
|
||||
(* associationend has changed *)
|
||||
(*SOME ((AssociationEndCall (source,type_of class,(name_of class)@[(#name assocend)],aend_to_attr_type assocend))) *)
|
||||
SOME ((AssociationEndCall (source,type_of class,(name_of class)@[List.last (#name assocend)],aend_to_attr_type assocend)))
|
||||
(*SOME ((AssociationEndCall (source,type_of class,(name_of class)@[(#name assocend)],convert_aend_type assocend))) *)
|
||||
SOME ((AssociationEndCall (source,type_of class,(name_of class)@[List.last (#name assocend)],convert_aend_type assocend)))
|
||||
else
|
||||
NONE
|
||||
end
|
||||
|
||||
(* RETURN: OclTerm *)
|
||||
fun upcast_att_ae [] source (model:transform_model) =
|
||||
fun upcast_att_aend [] source (model:transform_model) =
|
||||
raise UpcastingError ("interference_attr_or_assoc: No operation signature matches given types.")
|
||||
| upcast_att_ae ((class,SOME(attr:attribute),NONE)::class_attr_or_assoc_list) source model =
|
||||
| upcast_att_aend ((class,SOME(attr:attribute),NONE)::class_attr_or_assoc_list) source model =
|
||||
(
|
||||
case (upcast_att (class,attr) source model) of
|
||||
NONE => (upcast_att_ae class_attr_or_assoc_list source model)
|
||||
NONE => (upcast_att_aend class_attr_or_assoc_list source model)
|
||||
| SOME (term) => term
|
||||
)
|
||||
| upcast_att_ae ((class,NONE,SOME(assocend:associationend))::class_attr_or_assoc_list) source model =
|
||||
| upcast_att_aend ((class,NONE,SOME(assocend:associationend))::class_attr_or_assoc_list) source model =
|
||||
(
|
||||
case (upcast_ae (class,assocend) source model) of
|
||||
NONE => (upcast_att_ae class_attr_or_assoc_list source model)
|
||||
case (upcast_aend (class,assocend) source model) of
|
||||
NONE => (upcast_att_aend class_attr_or_assoc_list source model)
|
||||
| SOME (term) => term
|
||||
)
|
||||
|
||||
|
|
@ -2972,7 +2965,7 @@ fun get_attr_or_assoc source attr_name (model as (classifiers,associations)) =
|
|||
val _ = trace low ("overloaded attributes/associationends found: " ^ Int.toString (List.length attr_or_assocend_list) ^ "\n")
|
||||
in
|
||||
let
|
||||
val x = upcast_att_ae attr_or_assocend_list source model
|
||||
val x = upcast_att_aend attr_or_assocend_list source model
|
||||
val _ = trace low ("\nReturn type of attribute: " ^ string_of_OclType (type_of_term x) ^ "\n\n")
|
||||
in
|
||||
x
|
||||
|
|
@ -2981,15 +2974,15 @@ fun get_attr_or_assoc source attr_name (model as (classifiers,associations)) =
|
|||
|
||||
fun package_of_template_parameter typ =
|
||||
case (typ) of
|
||||
Set (t) => (package_of_template_parameter (template_parameter t)
|
||||
Set (t) => (package_of_template_parameter (type_of_template_parameter t)
|
||||
handle NoCollectionTypeError t => package_of_template_parameter t)
|
||||
| OrderedSet (t) => (package_of_template_parameter (template_parameter t)
|
||||
| OrderedSet (t) => (package_of_template_parameter (type_of_template_parameter t)
|
||||
handle NoCollectionTypeError t => package_of_template_parameter t)
|
||||
| Collection (t) => (package_of_template_parameter (template_parameter t)
|
||||
| Collection (t) => (package_of_template_parameter (type_of_template_parameter t)
|
||||
handle NoCollectionTypeError t => package_of_template_parameter t)
|
||||
| Sequence (t) => (package_of_template_parameter (template_parameter t)
|
||||
| Sequence (t) => (package_of_template_parameter (type_of_template_parameter t)
|
||||
handle NoCollectionTypeError t => package_of_template_parameter t)
|
||||
| Bag (t) => (package_of_template_parameter (template_parameter t)
|
||||
| Bag (t) => (package_of_template_parameter (type_of_template_parameter t)
|
||||
handle NoCollectionTypeError t => package_of_template_parameter t)
|
||||
| Integer => [OclLibPackage]
|
||||
| String => [OclLibPackage]
|
||||
|
|
@ -3013,7 +3006,7 @@ fun collection_type classifier =
|
|||
| Bag (T) => true
|
||||
| x => false
|
||||
|
||||
fun dispatch_collection (selector,typ) =
|
||||
fun create_set (selector,typ) =
|
||||
case selector of
|
||||
"Set" => Set (typ)
|
||||
| "Sequence" => Sequence (typ)
|
||||
|
|
|
|||
Loading…
Reference in New Issue