git-svn-id: https://projects.brucker.ch/su4sml/svn/su4sml/trunk@7438 3260e6d1-4efc-4170-b0a7-36055960796d
This commit is contained in:
Manuel Krucker
parent
93bb07e8e5
commit
71729d90d3
|
|
@ -128,10 +128,10 @@ fun FromSet_desugarator rterm path attr_or_meth rargs (model as (cls,assocs):Rep
|
|||
val ops = get_overloaded_methods class (List.last path) model
|
||||
in
|
||||
if (List.length ops = 0)
|
||||
then raise InterferenceError ("FromSet no operation/attribute found. \n")
|
||||
then raise UpcastingError ("FromSet no operation/attribute found. \n")
|
||||
else
|
||||
let
|
||||
val insert_term = interfere_methods ops (Variable iterVar) rargs model
|
||||
val insert_term = upcast_op ops (Variable iterVar) rargs model
|
||||
val it_type = type_of_term insert_term
|
||||
in
|
||||
Iterator ("collect",[iterVar],rterm,type_of_term rterm,insert_term,it_type,it_type)
|
||||
|
|
@ -147,10 +147,10 @@ fun FromSet_desugarator rterm path attr_or_meth rargs (model as (cls,assocs):Rep
|
|||
val attrs_or_assocs = get_overloaded_attrs_or_assocends class (List.last path) model
|
||||
in
|
||||
if (List.length attrs_or_assocs = 0)
|
||||
then raise InterferenceError ("Attriubte '" ^ (List.last path) ^ "' does not exist ... \n")
|
||||
then raise UpcastingError ("Attriubte '" ^ (List.last path) ^ "' does not exist ... \n")
|
||||
else
|
||||
let
|
||||
val insert_term = interfere_attrs_or_assocends attrs_or_assocs (Variable iterVar) model
|
||||
val insert_term = upcast_att_ae 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 *)
|
||||
|
|
@ -200,7 +200,7 @@ fun AsSet_desugarator rterm path attr_or_meth rargs (model as (cls,assocs)) =
|
|||
then
|
||||
raise NoSuchOperationError ("interefere_methods: No operation signature matches given types (source: "^(Ocl2String.ocl2string false rterm)^").")
|
||||
else
|
||||
interfere_methods ops new_rterm rargs model
|
||||
upcast_op ops new_rterm rargs model
|
||||
end
|
||||
else (* AttributeCall *)
|
||||
let
|
||||
|
|
@ -217,13 +217,13 @@ 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
|
||||
interfere_attrs_or_assocends attrs new_rterm model
|
||||
upcast_att_ae attrs new_rterm model
|
||||
end)
|
||||
|
||||
(* RETURN: OclTerm (OperationCall/AttributeCall) *)
|
||||
fun desugarator rterm path attr_or_meth rargs model =
|
||||
FromSet_desugarator rterm path attr_or_meth rargs model
|
||||
handle InterferenceError s => AsSet_desugarator rterm path attr_or_meth rargs model
|
||||
handle UpcastingError s => AsSet_desugarator rterm path attr_or_meth rargs model
|
||||
|
||||
(* RETURN: CollectionPart *)
|
||||
fun resolve_CollectionPart model (CollectionItem (term,typ)) =
|
||||
|
|
@ -307,12 +307,12 @@ and resolve_OclTerm (Literal (s,typ)) model =
|
|||
in
|
||||
if (List.hd attr_path = "arrow")
|
||||
then get_attr_or_assoc rterm (List.last attr_path) model
|
||||
handle InterferenceError s => AsSet_desugarator rterm (List.tl attr_path) 1 [] model
|
||||
handle UpcastingError s => AsSet_desugarator rterm (List.tl attr_path) 1 [] model
|
||||
else
|
||||
get_attr_or_assoc rterm (List.last attr_path) model
|
||||
|
||||
(* 2-dimensional inheritance of Collection types *)
|
||||
handle InterferenceError s =>
|
||||
handle UpcastingError s =>
|
||||
(
|
||||
(
|
||||
let
|
||||
|
|
@ -331,7 +331,7 @@ and resolve_OclTerm (Literal (s,typ)) model =
|
|||
in
|
||||
if (List.length attrs = 0)
|
||||
then raise DesugaratorCall (rterm,attr_path,1,[],model)
|
||||
else interfere_attrs_or_assocends attrs rterm model
|
||||
else upcast_att_ae attrs rterm model
|
||||
end
|
||||
)
|
||||
handle DesugaratorCall arg => desugarator (#1 arg) (#2 arg) (#3 arg) (#4 arg) (#5 arg)
|
||||
|
|
@ -423,11 +423,11 @@ let
|
|||
in
|
||||
if (List.hd meth_path = "arrow")
|
||||
then get_meth rterm (List.last meth_path) rargs model
|
||||
handle InterferenceError s => AsSet_desugarator rterm (List.tl meth_path) 0 rargs model
|
||||
handle UpcastingError s => AsSet_desugarator rterm (List.tl meth_path) 0 rargs model
|
||||
else
|
||||
get_meth rterm (List.last meth_path) rargs model
|
||||
(* 2-dimensional inheritance of Collection types *)
|
||||
handle InterferenceError s =>
|
||||
handle UpcastingError s =>
|
||||
(
|
||||
(
|
||||
let
|
||||
|
|
@ -445,7 +445,7 @@ let
|
|||
in
|
||||
if (List.length ops = 0)
|
||||
then raise DesugaratorCall (rterm, meth_path, 0, rargs, model)
|
||||
else interfere_methods ops rterm rargs model
|
||||
else upcast_op ops rterm rargs model
|
||||
end
|
||||
)
|
||||
handle DesugaratorCall arg => desugarator (#1 arg) (#2 arg) (#3 arg) (#4 arg) (#5 arg)
|
||||
|
|
|
|||
|
|
@ -149,7 +149,7 @@ type transform_model = (Classifier list * association list)
|
|||
|
||||
|
||||
(*****************************************
|
||||
* RETURN transform_model *
|
||||
* MODEL *
|
||||
*****************************************)
|
||||
(**
|
||||
* TODO: Description
|
||||
|
|
@ -162,7 +162,7 @@ val joinModel : transform_model -> transform_model -> transform_model
|
|||
val normalize_ext : transform_model -> transform_model
|
||||
|
||||
(*****************************************
|
||||
* RETURN Classifier *
|
||||
* CLASSIFIERS *
|
||||
*****************************************)
|
||||
(**
|
||||
* Ocl Classifier OclAny.
|
||||
|
|
@ -194,16 +194,23 @@ val class_of_type : Rep_OclType.OclType -> transform_model -> Classifi
|
|||
*)
|
||||
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
|
||||
|
||||
|
||||
(**
|
||||
* Returns the classifier of the parent of a classifier.
|
||||
*)
|
||||
val class_of_parent : Classifier -> transform_model -> Classifier
|
||||
|
||||
|
||||
(**
|
||||
* Update the thy_name of a classifier.
|
||||
|
|
@ -249,7 +256,7 @@ val connected_classifiers_of : association list -> Classifier -> Classifier list
|
|||
|
||||
|
||||
(*****************************************
|
||||
* RETURN OclType *
|
||||
* TYPES *
|
||||
*****************************************)
|
||||
|
||||
(**
|
||||
|
|
@ -328,7 +335,7 @@ val dispatch_collection : (string * Rep_OclType.OclType) -> Rep_OclType.OclT
|
|||
|
||||
|
||||
(*****************************************
|
||||
* RETURN OclTerms/CollectionPart *
|
||||
* TERMS/EXPRESSIONS *
|
||||
*****************************************)
|
||||
|
||||
|
||||
|
|
@ -341,19 +348,19 @@ val upcast : (Rep_OclTerm.OclTerm * Rep_OclType.OclType) -> Rep
|
|||
* Interfere the types of the arguments of an operation according to
|
||||
* a given signature, if possible.
|
||||
*)
|
||||
val interfere_args : (string * Rep_OclType.OclType) list -> (Rep_OclTerm.OclTerm * Rep_OclType.OclType) list
|
||||
val upcast_args : (string * Rep_OclType.OclType) list -> (Rep_OclTerm.OclTerm * Rep_OclType.OclType) list
|
||||
-> transform_model -> (Rep_OclTerm.OclTerm * Rep_OclType.OclType) list
|
||||
|
||||
(**
|
||||
* Interfere the types of an operation according to another operation, if possible.
|
||||
* Upcast the types of an operation according to another operation, if possible.
|
||||
*)
|
||||
val interfere_methods : (Classifier * operation) list -> Rep_OclTerm.OclTerm
|
||||
val upcast_op : (Classifier * operation) list -> Rep_OclTerm.OclTerm
|
||||
-> (Rep_OclTerm.OclTerm * Rep_OclType.OclType) list -> transform_model -> Rep_OclTerm.OclTerm
|
||||
|
||||
(**
|
||||
* Interfere the types of an assoc/attribute to an other assoc/attribute, if possible.
|
||||
* Upcast the types of an assoc/attribute to an other assoc/attribute, if possible.
|
||||
*)
|
||||
val interfere_attrs_or_assocends: (Classifier * attribute option * associationend option) list
|
||||
val upcast_att_ae : (Classifier * attribute option * associationend option) list
|
||||
-> Rep_OclTerm.OclTerm -> transform_model -> Rep_OclTerm.OclTerm
|
||||
(**
|
||||
* Prefixes all types in a term with the
|
||||
|
|
@ -369,7 +376,7 @@ val prefix_collectionpart : string list -> Rep_OclTerm.CollectionPart -> Rep_O
|
|||
|
||||
|
||||
(*****************************************
|
||||
* RETURN operation *
|
||||
* OPERATIONS *
|
||||
*****************************************)
|
||||
|
||||
(**
|
||||
|
|
@ -378,7 +385,7 @@ val prefix_collectionpart : string list -> Rep_OclTerm.CollectionPart -> Rep_O
|
|||
val find_operation : string -> operation list -> operation
|
||||
|
||||
(**
|
||||
* Find an attribute in a list of attributes.
|
||||
* Find an attribute in a list of attributes.
|
||||
*)
|
||||
val find_attribute : string -> attribute list -> attribute
|
||||
|
||||
|
|
@ -409,15 +416,28 @@ val protected_operations_of : Classifier -> transform_model -> operation list
|
|||
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 get_overloaded_methods : Classifier -> string -> transform_model -> (Classifier * operation) list
|
||||
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
|
||||
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.
|
||||
*)
|
||||
|
|
@ -458,11 +478,6 @@ val name_of_op : operation -> string
|
|||
*)
|
||||
val mangled_name_of_op : operation -> string
|
||||
|
||||
(**
|
||||
* TODO: Description (OBSOLETE?)
|
||||
*)
|
||||
(* val operation_of : Classifier list -> Rep_OclType.Path -> operation option *)
|
||||
|
||||
(**
|
||||
* Update an operation with new preconditions.
|
||||
*)
|
||||
|
|
@ -476,7 +491,7 @@ val update_postcondition : (string option * Rep_OclTerm.OclTerm) list ->
|
|||
operation -> operation
|
||||
|
||||
(*****************************************
|
||||
* RETURN signature *
|
||||
* SIGNATURES *
|
||||
*****************************************)
|
||||
|
||||
(**
|
||||
|
|
@ -488,7 +503,7 @@ val prefix_signature : string list -> (string * Rep_OclType.OclType) list
|
|||
|
||||
|
||||
(*****************************************
|
||||
* RETURN attribute *
|
||||
* attribute *
|
||||
*****************************************)
|
||||
(** OBSOLETE **)
|
||||
val attributes_of : Classifier -> attribute list
|
||||
|
|
@ -719,7 +734,7 @@ val correct_type_for_CollLiteral : Rep_OclType.OclType -> Rep_OclTerm.Collection
|
|||
(**
|
||||
* Are the (first args) arguments of the an operation conform to another operations (second args)?
|
||||
*)
|
||||
val args_interfereable : (string * Rep_OclType.OclType) list -> (Rep_OclTerm.OclTerm * Rep_OclType.OclType) list -> transform_model -> bool
|
||||
val args_upcastable : (string * Rep_OclType.OclType) list -> (Rep_OclTerm.OclTerm * Rep_OclType.OclType) list -> transform_model -> bool
|
||||
|
||||
|
||||
(** update model **)
|
||||
|
|
@ -732,7 +747,7 @@ exception InvalidArguments of string
|
|||
exception TemplateError of string
|
||||
exception TemplateInstantiationError of string
|
||||
exception GetClassifierError of string
|
||||
exception InterferenceError of string
|
||||
exception UpcastingError of string
|
||||
exception NoParentForDatatype of string
|
||||
exception NoModelReferenced of string
|
||||
exception NoCollectionTypeError of Rep_OclType.OclType
|
||||
|
|
@ -856,7 +871,7 @@ exception InvalidArguments of string
|
|||
exception TemplateError of string
|
||||
exception TemplateInstantiationError of string
|
||||
exception GetClassifierError of string
|
||||
exception InterferenceError of string
|
||||
exception UpcastingError of string
|
||||
exception NoParentForDatatype of string
|
||||
exception NoModelReferenced of string
|
||||
exception NoCollectionTypeError of Rep_OclType.OclType
|
||||
|
|
@ -1142,6 +1157,8 @@ and class_of_type (typ:OclType) (model:transform_model) =
|
|||
class_of_term (Variable ("x",typ)) model
|
||||
|
||||
|
||||
|
||||
|
||||
fun type_equals Integer (Classifier ([OclLibPackage,"Real"])) = true
|
||||
| type_equals (Classifier ([OclLibPackage,"Integer"])) Real = true
|
||||
| type_equals _ OclAny = true
|
||||
|
|
@ -2167,7 +2184,8 @@ fun package_of (Class{name,...}) =
|
|||
else []
|
||||
| package_of (Template{classifier,...}) = package_of classifier
|
||||
|
||||
|
||||
fun classes_of_package pkg (model as (clist,alist)) =
|
||||
List.filter (fn a => package_of a = pkg) clist
|
||||
|
||||
fun short_parent_name_of C =
|
||||
(case (parent_name_of C) of
|
||||
|
|
@ -2640,17 +2658,17 @@ 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 =
|
||||
let
|
||||
val classname = (rev o tl o rev) fq_name
|
||||
val operations = local_operations_of (class_of classname (cl,[]) model)
|
||||
val operations = local_operations_of (class_of classname (cl,[]))
|
||||
val name = (hd o rev) fq_name
|
||||
in
|
||||
SOME(hd (filter (fn a => if ((name_of_op a) = name)
|
||||
then true else false ) operations ))
|
||||
end
|
||||
*)
|
||||
*)
|
||||
|
||||
fun connected_classifiers_of (all_associations:association list)
|
||||
(C as Class {attributes,associations,...})
|
||||
|
|
@ -2696,8 +2714,8 @@ fun connected_classifiers_of (all_associations:association list)
|
|||
|
||||
|
||||
|
||||
fun args_interfereable [] [] model = true
|
||||
| args_interfereable ((str,typ)::tail) ((term,ttyp)::args) model =
|
||||
fun args_upcastable [] [] model = true
|
||||
| args_upcastable ((str,typ)::tail) ((term,ttyp)::args) model =
|
||||
let
|
||||
val _ = trace low ("must conform to: " ^ (string_of_OclType typ) ^ "\n")
|
||||
in
|
||||
|
|
@ -2707,55 +2725,55 @@ fun args_interfereable [] [] model = true
|
|||
false
|
||||
end
|
||||
(* not same nuber of arguments *)
|
||||
| args_interfereable [x] list model = false
|
||||
| args_interfereable list [x] model = false
|
||||
| args_upcastable [x] list model = false
|
||||
| args_upcastable list [x] model = false
|
||||
|
||||
(* RETURN: (OclTerm * OclType) list *)
|
||||
fun interfere_args [] [] model = []
|
||||
| interfere_args ((str,typ)::tail) ((term,_)::args) model =
|
||||
fun upcast_args [] [] model = []
|
||||
| upcast_args ((str,typ)::tail) ((term,_)::args) model =
|
||||
let
|
||||
val _ = trace low ("interfere args" ^ "\n")
|
||||
in
|
||||
if (type_equals typ (type_of_term term)) then
|
||||
(term,type_of_term term)::(interfere_args tail args model)
|
||||
(term,type_of_term term)::(upcast_args tail args model)
|
||||
else
|
||||
if (conforms_to (type_of_term term) typ model) then
|
||||
(term,typ)::(interfere_args tail args model)
|
||||
(term,typ)::(upcast_args tail args model)
|
||||
else
|
||||
raise InterferenceError ("Arguments are not interferebable \n")
|
||||
raise UpcastingError ("Arguments are not interferebable \n")
|
||||
end
|
||||
|
||||
(* RETURN: OclType *)
|
||||
fun interfere_res_type t1 t2 model =
|
||||
fun upcast_res_type t1 t2 model =
|
||||
if (conforms_to t1 t2 model)
|
||||
then t2
|
||||
else raise InterferenceError ("Result type does not conform \n")
|
||||
else raise UpcastingError ("Result type does not conform \n")
|
||||
|
||||
|
||||
(* RETURN: OclTerm *)
|
||||
fun interfere_methods [] source args model =
|
||||
fun upcast_op [] source args model =
|
||||
let
|
||||
val _ = trace development ("InterferenceError ... \n")
|
||||
val _ = trace development ("UpcastingError ... \n")
|
||||
in
|
||||
raise InterferenceError ("interefere_methods: No operation signature matches given types.")
|
||||
raise UpcastingError ("interefere_methods: No operation signature matches given types.")
|
||||
end
|
||||
| interfere_methods ((class,meth)::class_meth_list) source args model =
|
||||
| upcast_op ((class,meth)::class_meth_list) 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_interfereable (#arguments meth) args model
|
||||
val _ = trace low ("Interfereable ? : Source conforms : " ^ Bool.toString check_source ^ " Args conforms : " ^ Bool.toString check_args ^ "\n")
|
||||
val check_args = args_upcastable (#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
|
||||
if (check_source andalso check_args) then
|
||||
(* signature matches given types *)
|
||||
(OperationCall(source,type_of class,(name_of class)@[name_of_op meth],interfere_args (#arguments meth) args model,result_of_op meth))
|
||||
(OperationCall(source,type_of class,(name_of class)@[name_of_op meth],upcast_args (#arguments meth) args model,result_of_op meth))
|
||||
else
|
||||
(interfere_methods class_meth_list source args model)
|
||||
(upcast_op class_meth_list source args model)
|
||||
end
|
||||
|
||||
(* RETURN: (OclTerm) *)
|
||||
fun interfere_attrs (class,attr:attribute) source (model:transform_model) =
|
||||
fun upcast_att (class,attr:attribute) source (model:transform_model) =
|
||||
let
|
||||
val check_source = conforms_to (type_of_term source) (type_of class) model
|
||||
val _ = trace low ("interfere attribute: check_source "^ Bool.toString check_source ^ "\n\n")
|
||||
|
|
@ -2767,8 +2785,8 @@ fun interfere_attrs (class,attr:attribute) source (model:transform_model) =
|
|||
NONE
|
||||
end
|
||||
|
||||
(* RETURN: OclTerm option*)
|
||||
fun interfere_assocends (class,assocend:associationend) source (model:transform_model) =
|
||||
|
||||
fun upcast_ae (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")
|
||||
|
|
@ -2784,18 +2802,18 @@ fun interfere_assocends (class,assocend:associationend) source (model:transform_
|
|||
end
|
||||
|
||||
(* RETURN: OclTerm *)
|
||||
fun interfere_attrs_or_assocends [] source (model:transform_model) =
|
||||
raise InterferenceError ("interference_attr_or_assoc: No operation signature matches given types.")
|
||||
| interfere_attrs_or_assocends ((class,SOME(attr:attribute),NONE)::class_attr_or_assoc_list) source model =
|
||||
fun upcast_att_ae [] 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 =
|
||||
(
|
||||
case (interfere_attrs (class,attr) source model) of
|
||||
NONE => (interfere_attrs_or_assocends 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)
|
||||
| SOME (term) => term
|
||||
)
|
||||
| interfere_attrs_or_assocends ((class,NONE,SOME(assocend:associationend))::class_attr_or_assoc_list) source model =
|
||||
| upcast_att_ae ((class,NONE,SOME(assocend:associationend))::class_attr_or_assoc_list) source model =
|
||||
(
|
||||
case (interfere_assocends (class,assocend) source model) of
|
||||
NONE => (interfere_attrs_or_assocends 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)
|
||||
| SOME (term) => term
|
||||
)
|
||||
|
||||
|
|
@ -2942,7 +2960,7 @@ fun get_meth source op_name args (model as (classifiers,associations))=
|
|||
val meth_list = get_overloaded_methods class op_name model
|
||||
val _ = trace low ("overloaded methods found: " ^ Int.toString (List.length meth_list) ^ "\n")
|
||||
in
|
||||
interfere_methods meth_list source args model
|
||||
upcast_op meth_list source args model
|
||||
end
|
||||
|
||||
fun get_attr_or_assoc source attr_name (model as (classifiers,associations)) =
|
||||
|
|
@ -2954,7 +2972,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 = interfere_attrs_or_assocends attr_or_assocend_list source model
|
||||
val x = upcast_att_ae attr_or_assocend_list source model
|
||||
val _ = trace low ("\nReturn type of attribute: " ^ string_of_OclType (type_of_term x) ^ "\n\n")
|
||||
in
|
||||
x
|
||||
|
|
@ -3015,5 +3033,20 @@ fun correct_type_for_CollLiteral coll_typ (CollectionItem (term,typ)) =
|
|||
else
|
||||
false
|
||||
|
||||
fun local_invariants_of class = invariant_of class
|
||||
|
||||
fun inherited_invariants_of class (model:transform_model as (clist,alist)) =
|
||||
let
|
||||
val parent = parent_of class (#1 model)
|
||||
in
|
||||
if (type_of parent = OclAny)
|
||||
then []
|
||||
else (local_invariants_of class)@(inherited_invariants_of parent model)
|
||||
end
|
||||
|
||||
fun all_invariants_of class model =
|
||||
(local_invariants_of class)@(inherited_invariants_of class model)
|
||||
|
||||
|
||||
end
|
||||
|
||||
|
|
|
|||
|
|
@ -61,22 +61,17 @@ sig
|
|||
val conjugate_terms : Rep_OclTerm.OclTerm list -> Rep_OclTerm.OclTerm
|
||||
(** *)
|
||||
val disjugate_terms : Rep_OclTerm.OclTerm list -> Rep_OclTerm.OclTerm
|
||||
(** Transform a option list to a normal list.*)
|
||||
val optlist2list : 'a option list -> 'a list
|
||||
(** Get an attribute by name. *)
|
||||
val get_attribute : string -> Rep_Core.Classifier -> Rep.Model -> Rep_Core.attribute
|
||||
(** Get an operation by name. *)
|
||||
val get_operation : string -> Rep_Core.Classifier -> Rep.Model -> Rep_Core.operation
|
||||
(** Test wheter the signatures are type consistent.*)
|
||||
val sig_conforms_to : (string * Rep_OclType.OclType) list -> (string * Rep_OclType.OclType) list -> Rep.Model -> bool
|
||||
(** Check if the operation is a refinement of another operation.*)
|
||||
val same_op : Rep_Core.operation -> Rep_Core.operation -> Rep.Model -> bool
|
||||
|
||||
(** *)
|
||||
val class_contains_op : Rep_Core.operation -> Rep.Model -> Rep_Core.Classifier -> bool
|
||||
(** *)
|
||||
val class_has_local_op : string -> Rep.Model -> Rep_Core.Classifier -> bool
|
||||
(** *)
|
||||
val class_of_package : Rep_OclType.Path -> Rep.Model -> Rep_Core.Classifier list
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
|
@ -85,12 +80,6 @@ sig
|
|||
val children_of : Rep_Core.Classifier -> Rep.Model -> Rep_OclType.Path list
|
||||
(** Check inheritance tree for a given property and return first classifer fullfilling property.*)
|
||||
val go_up_hierarchy : Rep_Core.Classifier -> (Rep_Core.Classifier -> bool) -> Rep.Model -> Rep_Core.Classifier
|
||||
(** Get the local invariants of a classifier.*)
|
||||
val local_invariants_of : Rep_Core.Classifier -> (string option * Rep_OclTerm.OclTerm) list
|
||||
(** Get the inherited invarinats of a classifier.*)
|
||||
val inherited_invariants_of : Rep_Core.Classifier -> Rep.Model -> (string option * Rep_OclTerm.OclTerm) list
|
||||
(** Get all invariants of a classifier.*)
|
||||
val all_invariants_of : Rep_Core.Classifier -> Rep.Model -> (string option * Rep_OclTerm.OclTerm) list
|
||||
(** get the relative path according to the package *)
|
||||
val rel_path_of : Rep_OclType.Path -> Rep_OclType.Path -> Rep_OclType.Path
|
||||
(** Substitute a package name of a path. *)
|
||||
|
|
@ -255,19 +244,7 @@ fun has_children class (model as (clist,alist)) =
|
|||
|
||||
|
||||
|
||||
fun local_invariants_of class = invariant_of class
|
||||
|
||||
fun inherited_invariants_of class (model:Rep.Model as (clist,alist)) =
|
||||
let
|
||||
val parent = parent_of class (#1 model)
|
||||
in
|
||||
if (type_of parent = OclAny)
|
||||
then []
|
||||
else (local_invariants_of class)@(inherited_invariants_of parent model)
|
||||
end
|
||||
|
||||
fun all_invariants_of class model =
|
||||
(local_invariants_of class)@(inherited_invariants_of class model)
|
||||
|
||||
|
||||
fun rel_path_of [] name = name
|
||||
|
|
@ -285,9 +262,6 @@ fun substitute_package [] tpackage [] = raise WFCPOG_LibraryError ("Not possible
|
|||
then substitute_package fpackage tpackage path
|
||||
else (hp::path)
|
||||
|
||||
fun class_of_package pkg (model as (clist,alist)) =
|
||||
List.filter (fn a => package_of a = pkg) clist
|
||||
|
||||
fun args2varargs [] = []
|
||||
| args2varargs ((a,b)::tail) = (Variable(a,b),b)::(args2varargs tail)
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue