HOL-OCL
/
su4sml
1
0
Fork 0
Code Issues Pull Requests Releases Activity

git-svn-id: https://projects.brucker.ch/su4sml/svn/su4sml/trunk@7439 3260e6d1-4efc-4170-b0a7-36055960796d

This commit is contained in:
Manuel Krucker 2008-03-18 15:01:52 +00:00
parent 71729d90d3
commit 88f231cfbf
6 changed files with 295 additions and 304 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
su4sml/src/codegen/base_cartridge.sml
View File

@ -152,7 +152,7 @@ fun curClassifierPackageToString env p2sfun = (case (#curClassifier env) of
fun lookup env "classifier_name" = Rep_Core.short_name_of (curClassifier' env) 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" = curClassifierPackageToString env Rep_OclType.string_of_path
| lookup env "classifier_package_path" = curClassifierPackageToString env Rep_OclType.pathstring_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_name" = #name (curAttribute' env)
| lookup env "attribute_type" = oclType2Native (#attr_type (curAttribute' env)) | lookup env "attribute_type" = oclType2Native (#attr_type (curAttribute' env))

10
su4sml/src/ocl_parser/ocl.grm
View File

@ -399,8 +399,8 @@ op_constraint_stereotype_cs : PRE (PRE)
(* RETURN: OclTerm *) (* RETURN: OclTerm *)
collection_literal_exp_cs : collection_type_identifier_cs BRACE_OPEN BRACE_CLOSE (CollectionLiteral ([],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,dispatch_collection(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 *) (* 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 *) (* renamed to collection_type_specifier_cs from collection_type_cs *)
(* RETURN: OclType *) (* 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 *) (* RETURN: string *)
collection_type_identifier_cs: SET (SET) 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)) | 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 (* 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 | path_name_cs qualifiers time_exp_cs
*) *)
@ -695,7 +695,7 @@ type_specifier: simple_type_specifier_cs
*) *)
(* RETURN: OclType *) (* 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 *) (* RETURN: (string * OclType * OclTerm) list *)

10
su4sml/src/ocl_parser/ocl.grm.sml
View File

@ -1865,7 +1865,7 @@ collection_type_identifier_cs1) = collection_type_identifier_cs1 ()
val BRACE_OPEN1 = BRACE_OPEN1 () val BRACE_OPEN1 = BRACE_OPEN1 ()
val BRACE_CLOSE1 = BRACE_CLOSE1 () val BRACE_CLOSE1 = BRACE_CLOSE1 ()
in ( in (
CollectionLiteral ([],dispatch_collection (collection_type_identifier_cs,DummyT)) CollectionLiteral ([],create_set (collection_type_identifier_cs,DummyT))
) )
end) end)
in ( LrTable.NT 63, ( result, collection_type_identifier_cs1left, 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 () collection_literal_parts_cs1 ()
val BRACE_CLOSE1 = BRACE_CLOSE1 () val BRACE_CLOSE1 = BRACE_CLOSE1 ()
in ( 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) end)
in ( LrTable.NT 63, ( result, collection_type_identifier_cs1left, in ( LrTable.NT 63, ( result, collection_type_identifier_cs1left,
@ -1972,9 +1972,7 @@ collection_type_identifier_cs1 ()
val PAREN_OPEN1 = PAREN_OPEN1 () val PAREN_OPEN1 = PAREN_OPEN1 ()
val (type_specifier as type_specifier1) = type_specifier1 () val (type_specifier as type_specifier1) = type_specifier1 ()
val PAREN_CLOSE1 = PAREN_CLOSE1 () val PAREN_CLOSE1 = PAREN_CLOSE1 ()
in ( in (create_set (collection_type_identifier_cs,type_specifier))
dispatch_collection (collection_type_identifier_cs,type_specifier))
end) end)
in ( LrTable.NT 48, ( result, collection_type_identifier_cs1left, in ( LrTable.NT 48, ( result, collection_type_identifier_cs1left,
PAREN_CLOSE1right), rest671) PAREN_CLOSE1right), rest671)
@ -3238,7 +3236,7 @@ end
, simple_name1right)) :: rest671)) => let val result = , simple_name1right)) :: rest671)) => let val result =
MlyValue.simple_type_specifier_cs (fn _ => let val (simple_name as MlyValue.simple_type_specifier_cs (fn _ => let val (simple_name as
simple_name1) = simple_name1 () simple_name1) = simple_name1 ()
in (path_to_type [simple_name]) in (type_of_path [simple_name])
end) end)
in ( LrTable.NT 52, ( result, simple_name1left, simple_name1right), in ( LrTable.NT 52, ( result, simple_name1left, simple_name1right),
rest671) rest671)

4
su4sml/src/ocl_parser/preprocessor.sml
View File

@ -294,10 +294,10 @@ and generate_variables (Literal (paras)) path meth_name model = Literal (paras)
val classifier = class_of path (model,[]) val classifier = class_of path (model,[])
val _ = trace low "classifier found\n" val _ = trace low "classifier found\n"
val meth_list = operations_of classifier 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") val _ = trace zero ("a result call resolved ..." ^ "\n")
in in
(Variable ("result",(#result meth))) (Variable ("result",(#result (valOf(meth)))))
end end
| generate_variables (AttributeCall (sterm,styp,p,res_typ)) path meth_name model = | generate_variables (AttributeCall (sterm,styp,p,res_typ)) path meth_name model =
(AttributeCall (generate_variables sterm path meth_name model,styp,p,res_typ)) (AttributeCall (generate_variables sterm path meth_name model,styp,p,res_typ))

42
su4sml/src/ocl_parser/type_checker.sml
View File

@ -122,7 +122,7 @@ fun FromSet_desugarator rterm path attr_or_meth rargs (model as (cls,assocs):Rep
let let
(* check 'fromSet' *) (* check 'fromSet' *)
val _ = trace low ("\n==> FromSet-desugarator: operation ... \n") 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 iterVar = (("anonIterVar_" ^ (varcounter.nextStr())),new_type)
val class = class_of_term (Variable (iterVar)) model val class = class_of_term (Variable (iterVar)) model
val ops = get_overloaded_methods class (List.last path) 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 let
(* check 'fromSet' *) (* check 'fromSet' *)
val _ = trace low ("\n==> FromSet-desugarator: attribute/assocend ... \n") 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 iterVar = (("anonIterVar_" ^ (varcounter.nextStr())),new_type)
val class = class_of_term (Variable (iterVar)) model val class = class_of_term (Variable (iterVar)) model
val attrs_or_assocs = get_overloaded_attrs_or_assocends class (List.last path) 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") then raise UpcastingError ("Attriubte '" ^ (List.last path) ^ "' does not exist ... \n")
else else
let 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 it_type = type_of_term insert_term
val _ = trace development ("association type " ^ string_of_OclType it_type ^ "\n") val _ = trace development ("association type " ^ string_of_OclType it_type ^ "\n")
(* special case *) (* special case *)
@ -161,7 +161,7 @@ fun FromSet_desugarator rterm path attr_or_meth rargs (model as (cls,assocs):Rep
(* AttributeCall *) (* AttributeCall *)
(x,SOME(shit),NONE) => (x,SOME(shit),NONE) =>
let 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 in
Iterator ("collect",[iterVar],rterm,type_of_term rterm,insert_term,it_type,ret_type) Iterator ("collect",[iterVar],rterm,type_of_term rterm,insert_term,it_type,ret_type)
end end
@ -170,13 +170,13 @@ fun FromSet_desugarator rterm path attr_or_meth rargs (model as (cls,assocs):Rep
if (isColl_Type it_type) if (isColl_Type it_type)
then then
let 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 in
Iterator("collect",[iterVar],rterm,type_of_term rterm,insert_term,it_type,ret_type) Iterator("collect",[iterVar],rterm,type_of_term rterm,insert_term,it_type,ret_type)
end end
else else
let 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 in
Iterator("collect",[iterVar],rterm,type_of_term rterm,insert_term,it_type,ret_type) Iterator("collect",[iterVar],rterm,type_of_term rterm,insert_term,it_type,ret_type)
end end
@ -217,7 +217,7 @@ fun AsSet_desugarator rterm path attr_or_meth rargs (model as (cls,assocs)) =
then then
raise NoSuchAttributeError ("Attriubte '" ^ (List.last path) ^ "' does not exist ... \n") raise NoSuchAttributeError ("Attriubte '" ^ (List.last path) ^ "' does not exist ... \n")
else else
upcast_att_ae attrs new_rterm model upcast_att_aend attrs new_rterm model
end) end)
(* RETURN: OclTerm (OperationCall/AttributeCall) *) (* 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 _ = trace low ("\n==> 2-dim Inheritance check: ma attribute/assocend\n")
val rtyp = type_of_term rterm val rtyp = type_of_term rterm
val _ = trace low (string_of_OclType rtyp ^ "manu \n") 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 pclass = class_of_term (Variable ("x",templ_type)) model
val _ = trace low ("manu 2") val _ = trace low ("manu 2")
val ntempl_type = type_of_parent pclass val ntempl_type = type_of_parent pclass
val _ = trace low ("manu 3") 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 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 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") val _ = trace low ("parent type of term:" ^ string_of_OclType new_type ^ "\n")
in in
if (List.length attrs = 0) if (List.length attrs = 0)
then raise DesugaratorCall (rterm,attr_path,1,[],model) then raise DesugaratorCall (rterm,attr_path,1,[],model)
else upcast_att_ae attrs rterm model else upcast_att_aend attrs rterm model
end end
) )
handle DesugaratorCall arg => desugarator (#1 arg) (#2 arg) (#3 arg) (#4 arg) (#5 arg) 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 class = class_of_term rterm model
val prfx = package_of class val prfx = package_of class
val _ = trace low ("type of classifier: " ^ string_of_path prfx ^ "\n") 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") val _ = trace low ("res OpCall: oclTypeOf 4:" ^ "... " ^ "\n")
in in
OperationWithType (rterm,rtyp,"oclIsTypeOf",ctyp,Boolean) OperationWithType (rterm,rtyp,"oclIsTypeOf",ctyp,Boolean)
@ -375,7 +375,7 @@ let
val class = class_of_term rterm model val class = class_of_term rterm model
val prfx = package_of class val prfx = package_of class
val _ = trace low ("type of classifier: " ^ string_of_path prfx ^ "\n") 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") val _ = trace low ("res OpCall: oclIsKindOf 4:" ^ "... " ^ "\n")
in in
OperationWithType (rterm,rtyp,"oclIsKindOf",ctyp,Boolean) OperationWithType (rterm,rtyp,"oclIsKindOf",ctyp,Boolean)
@ -393,7 +393,7 @@ let
val class = class_of_term rterm model val class = class_of_term rterm model
val prfx = package_of class val prfx = package_of class
val _ = trace low ("type of classifier: " ^ string_of_path prfx ^ "\n") 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") val _ = trace low ("res OpCall: oclAsType 4:" ^ "... " ^ "\n")
in in
OperationWithType (rterm,rtyp,"oclAsType",ctyp,ctyp) OperationWithType (rterm,rtyp,"oclAsType",ctyp,ctyp)
@ -434,11 +434,11 @@ let
val _ = trace low ("\n==> 2-dim Inheritance check: attribute/assocend\n") val _ = trace low ("\n==> 2-dim Inheritance check: attribute/assocend\n")
val rtyp = type_of_term rterm val rtyp = type_of_term rterm
val _ = trace low (string_of_OclType rtyp ^ "\n") 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 pclass = class_of_term (Variable ("x",templ_type)) model
val ntempl_type = type_of_parent pclass val ntempl_type = type_of_parent pclass
val _ = trace low (string_of_OclType ntempl_type ^ "\n") 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 new_class = class_of_term (Variable ("x",new_type)) model
val ops = get_overloaded_methods new_class (List.last meth_path) 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") 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 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") 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 *) (* 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 ("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 ("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") val _ = trace low ("\nstatic iter type : " ^ string_of_OclType static_iter_type ^ " \n")
@ -504,7 +504,7 @@ end
| "exists" => | "exists" =>
Iterator (name,piter_vars,rterm,rtyp,rexpr,type_of_term rexpr,Boolean) Iterator (name,piter_vars,rterm,rtyp,rexpr,type_of_term rexpr,Boolean)
| "collect" => | "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 ...")) | _ => raise NoSuchIteratorNameError (Iterator (name,iter_vars,source_term,DummyT,expr,expr_typ,res_typ),("No such Iterator ..."))
) )
end end
@ -528,7 +528,7 @@ let
val piter_types = List.map (fn (a,b) => b) piter_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") val _ = trace medium ("res Iterate: first iter types: " ^ string_of_OclType (List.hd piter_types) ^ "\n")
(* check if iterator types correspond to source type *) (* 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 ("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 ("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 ("\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) val typ = type_of_CollPart (List.hd r_coll_parts)
in in
if (List.all (correct_type_for_CollLiteral typ) r_coll_parts) then 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 else
raise (wrongCollectionLiteral ((CollectionLiteral (coll_parts,temp_typ)), ("not all Literals have type of Collection"))) raise (wrongCollectionLiteral ((CollectionLiteral (coll_parts,temp_typ)), ("not all Literals have type of Collection")))
end end
@ -616,7 +616,7 @@ let
val _ = trace high ("pre/post/body : " ^ Ocl2String.ocl2string false expr ^ "\n") val _ = trace high ("pre/post/body : " ^ Ocl2String.ocl2string false expr ^ "\n")
val classifier = class_of_type (Classifier (path)) model val classifier = class_of_type (Classifier (path)) model
val oper_list = operations_of classifier 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 check1 = (op_sign = (#arguments oper))
val check2 = (result_type = (#result oper)) val check2 = (result_type = (#result oper))
val _ = trace low ("check1 = " ^ Bool.toString check1 ^ ", check2 = " ^ Bool.toString check2 ^ "\n") val _ = trace low ("check1 = " ^ Bool.toString check1 ^ ", check2 = " ^ Bool.toString check2 ^ "\n")
@ -637,7 +637,7 @@ end
val _ = trace low ( "classifier found ... " ^ "\n") val _ = trace low ( "classifier found ... " ^ "\n")
val attr_list = attributes_of classifier val attr_list = attributes_of classifier
val _ = trace low ( "attr_list found ... " ^ "\n") 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") val _ = trace low ( "attribute found ... " ^ "\n")
in in
if (typ = #attr_type attr) if (typ = #attr_type attr)

517
su4sml/src/rep_core.sml
View File

@ -161,14 +161,6 @@ val joinModel : transform_model -> transform_model -> transform_model
*) *)
val normalize_ext : transform_model -> transform_model val normalize_ext : transform_model -> transform_model
(*****************************************
* CLASSIFIERS *
*****************************************)
(**
* Ocl Classifier OclAny.
*)
val OclAnyC : Classifier
(** (**
* TODO: Description * TODO: Description
*) *)
@ -179,39 +171,6 @@ val normalize : association list -> Classifier -> Classifier
*) *)
val normalize_init : 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. * 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 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 * * 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 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 * 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. * returns the type of the classifier this association end belongs to.
@ -294,9 +316,9 @@ val path_to_type : Rep_OclType.Path -> Rep_OclType.OclType
val type_of_aend : associationend -> 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 * 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. * 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. * 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. * Prefixes a type with a given package name.
*) *)
val prefix_type : string list -> Rep_OclType.OclType -> Rep_OclType.OclType 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. * 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. * 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 * * TERMS/EXPRESSIONS *
*****************************************) *****************************************)
(** (**
* Upcast an OclTerm. * Upcast an OclTerm.
*) *)
val upcast : (Rep_OclTerm.OclTerm * Rep_OclType.OclType) -> Rep_OclTerm.OclTerm val upcast : (Rep_OclTerm.OclTerm * Rep_OclType.OclType) -> Rep_OclTerm.OclTerm
(**
* 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 * Interfere the types of the arguments of an operation according to
* a given signature, if possible. * a given signature, if possible.
*) *)
val upcast_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 -> 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 operation according to another operation, if possible. * Upcast the types of an attribute to an other attribute, if possible.
*) *)
val upcast_op : (Classifier * operation) list -> Rep_OclTerm.OclTerm val upcast_att : (Classifier * attribute) -> Rep_OclTerm.OclTerm -> transform_model -> Rep_OclTerm.OclTerm option
-> (Rep_OclTerm.OclTerm * Rep_OclType.OclType) list -> transform_model -> Rep_OclTerm.OclTerm
(**
* 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. * 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 -> Rep_OclTerm.OclTerm -> transform_model -> Rep_OclTerm.OclTerm
(** (**
* Prefixes all types in a term with the * 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. * Find an operation in a list of operations.
*) *)
val find_operation : string -> operation list -> operation val get_operation : string -> operation list -> operation option
(**
* Find an attribute in a list of attributes.
*)
val find_attribute : string -> attribute list -> attribute
(** OBSOLETE **)
val operations_of : Classifier -> operation list
(** Get the local operations of a classifier.*) (** Get the local operations of a classifier.*)
val local_operations_of : Classifier -> operation list val local_operations_of : Classifier -> operation list
(** Get the redefined/refined operations of a classifier.*) (** 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.*) (** Get all command operations of a classifier.*)
val command_operations_of : Classifier -> transform_model -> operation list val command_operations_of : Classifier -> transform_model -> operation list
(** Get the local invariants of a classifier.*) (** Get the local invariants of a classifier.*)
val local_invariants_of : Classifier -> (string option * Rep_OclTerm.OclTerm) list val local_invariants_of : Classifier -> (string option * Rep_OclTerm.OclTerm) list
(** Get the inherited invarinats of a classifier.*) (** Get the inherited invarinats of a classifier.*)
val inherited_invariants_of : Classifier -> transform_model -> (string option * Rep_OclTerm.OclTerm) list val inherited_invariants_of : Classifier -> transform_model -> (string option * Rep_OclTerm.OclTerm) list
(** Get all invariants of a classifier.*) (** Get all invariants of a classifier.*)
val all_invariants_of : Classifier -> transform_model -> (string option * Rep_OclTerm.OclTerm) list val all_invariants_of : Classifier -> transform_model -> (string option * Rep_OclTerm.OclTerm) list
(** OBSOLETE **)
val operations_of : Classifier -> operation list
(** OBSOLETE **) (** OBSOLETE **)
val get_overloaded_methods : Classifier -> string -> transform_model -> (Classifier * operation) list val get_overloaded_methods : Classifier -> string -> transform_model -> (Classifier * operation) list
(** OBSOLETE **) (** OBSOLETE **)
val get_meth : Rep_OclTerm.OclTerm -> string -> (Rep_OclTerm.OclTerm * Rep_OclType.OclType) list val get_meth : Rep_OclTerm.OclTerm -> string -> (Rep_OclTerm.OclTerm * Rep_OclType.OclType) list
-> transform_model -> Rep_OclTerm.OclTerm -> 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. * 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 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. * Returns the body of an operation.
*) *)
@ -473,6 +509,11 @@ val result_of_op : operation -> Rep_OclType.OclType
*) *)
val name_of_op : operation -> string val name_of_op : operation -> string
(**
* Is the operation visible?
*)
val is_visible_op : operation -> bool
(** (**
* TODO: Description * TODO: Description
*) *)
@ -491,31 +532,32 @@ val update_postcondition : (string option * Rep_OclTerm.OclTerm) list ->
operation -> operation operation -> operation
(***************************************** (*****************************************
* SIGNATURES * * ATTRIBUTES *
*****************************************) *****************************************)
(** (**
* Prefixes all types in the signature with a * Find an attribute in a list of attributes.
* given string list.
*) *)
val prefix_signature : string list -> (string * Rep_OclType.OclType) list -> (string * Rep_OclType.OclType) list val get_attribute : string -> attribute list -> attribute option
(*****************************************
* attribute *
*****************************************)
(** OBSOLETE **) (** OBSOLETE **)
val attributes_of : Classifier -> attribute list val attributes_of : Classifier -> attribute list
(** OBSOLETE **) (** OBSOLETE **)
val get_overloaded_attrs_or_assocends : Classifier -> string -> transform_model val get_overloaded_attrs_or_assocends : Classifier -> string -> transform_model
-> (Classifier * attribute option * associationend option) list -> (Classifier * attribute option * associationend option) list
(** OBSOLETE **) (** OBSOLETE **)
val get_attr_or_assoc : Rep_OclTerm.OclTerm -> string -> transform_model -> Rep_OclTerm.OclTerm 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 Rep_OclType.Path -> associationend list
(***************************************** (*****************************************
* RETURN association * * PARENTS [ OK ] *
*****************************************)
(*****************************************
* RETURN Path/string *
*****************************************) *****************************************)
(** (**
* Returns the name of the classifier. * Returns the classifier of the parent of classifier.
*) *)
val name_of : Classifier -> Rep_OclType.Path 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. * Returns one of the parents from the classifier.
*) *)
val parent_name_of : Classifier -> Rep_OclType.Path 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 * Returns the name of the package from the
* parent class. * parent class.
*) *)
val parent_package_of : Classifier -> Rep_OclType.Path 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 * Returns the last part (last string in path) of the name
* of the parent of the classifier. * 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 * 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 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. * Path of the association.
@ -663,11 +720,6 @@ val path_of_aend: associationend -> Rep_OclType.Path
*) *)
val role_of_aend : associationend -> string 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. * 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 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 * * 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 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 InvalidArguments of string
exception TemplateError of string exception TemplateError of string
exception TemplateInstantiationError of string exception TemplateInstantiationError of string
exception GetClassifierError of string exception GetClassifierError of string
exception UpcastingError of string exception UpcastingError of string
exception OperationNotFoundError of string
exception NoParentForDatatype of string exception NoParentForDatatype of string
exception NoModelReferenced of string exception NoModelReferenced of string
exception NoCollectionTypeError of Rep_OclType.OclType exception NoCollectionTypeError of Rep_OclType.OclType
@ -875,7 +873,7 @@ exception UpcastingError of string
exception NoParentForDatatype of string exception NoParentForDatatype of string
exception NoModelReferenced of string exception NoModelReferenced of string
exception NoCollectionTypeError of Rep_OclType.OclType exception NoCollectionTypeError of Rep_OclType.OclType
exception OperationNotFoundError of string
val OclLibPackage = "oclLib" val OclLibPackage = "oclLib"
val OclAnyC = Class{name=Rep_OclType.OclAny,parent=NONE,attributes=[], 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 arguments_of_op ({arguments,...}:operation) = arguments
fun path_to_type ["Integer"] = Integer fun type_of_path ["Integer"] = Integer
| path_to_type ["Boolean"] = Boolean | type_of_path ["Boolean"] = Boolean
| path_to_type ["Real"] = Real | type_of_path ["Real"] = Real
| path_to_type ["OclAny"] = OclAny | type_of_path ["OclAny"] = OclAny
| path_to_type ["DummyT"] = DummyT | type_of_path ["DummyT"] = DummyT
| path_to_type ["String"] = String | type_of_path ["String"] = String
| path_to_type ["OclVoid"] = OclVoid | type_of_path ["OclVoid"] = OclVoid
| path_to_type (("oclLib")::tail) = path_to_type tail | type_of_path (("oclLib")::tail) = type_of_path tail
| path_to_type [set] = | type_of_path [set] =
if (List.exists (fn a => if (a = (#"(")) then true else false) (String.explode set)) then if (List.exists (fn a => if (a = (#"(")) then true else false) (String.explode set)) then
(* set *) (* set *)
let let
@ -968,22 +966,20 @@ fun path_to_type ["Integer"] = Integer
val _ = TextIO.output(TextIO.stdOut,"tail "^ (String.implode tail) ^ "\n") val _ = TextIO.output(TextIO.stdOut,"tail "^ (String.implode tail) ^ "\n")
in 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 end
else else
Classifier ([set]) 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 fun operations_of class = local_operations_of class
| 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 class_of_term source (c:Classifier list, a:association list) = fun class_of_term source (c:Classifier list, a:association list) =
let 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 ("top level package: " ^ (List.hd (name)) ^ "\n")
val _ = trace low ("remaining package: " ^ (String.concat (List.tl name)) ^ "\n") val _ = trace low ("remaining package: " ^ (String.concat (List.tl name)) ^ "\n")
in in
class_of_term (Variable("x",path_to_type name)) model class_of_term (Variable("x",type_of_path name)) model
end end
and class_of_type (typ:OclType) (model:transform_model) = and class_of_type (typ:OclType) (model:transform_model) =
@ -1349,7 +1345,7 @@ fun inherited_operations_of class (model as (clist,alist)) =
let let
val parents = parents_of class (#1 model) val parents = parents_of class (#1 model)
val _ = trace 50 ("inh ops 2\n") 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 _ = trace 50 ("inh ops 3\n")
val ops_of_par = (List.map (operations_of) c_parents) val ops_of_par = (List.map (operations_of) c_parents)
val _ = trace 50 ("inh ops 4\n") 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 *) (* 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) = ordered,visibility,init}:associationend) =
(case multiplicity of (case multiplicity of
[(0,1)] => aend_type [(0,1)] => aend_type
@ -1457,9 +1453,9 @@ fun aend_to_attr_type ({name,aend_type,multiplicity,
else Rep_OclType.Set aend_type) 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), {name = List.last (#name aend),
attr_type = aend_to_attr_type aend, attr_type = convert_aend_type aend,
visibility = #visibility aend, visibility = #visibility aend,
scope = XMI.InstanceScope, scope = XMI.InstanceScope,
stereotypes = nil, stereotypes = nil,
@ -1471,7 +1467,7 @@ fun aend_to_attr (cls_name:string) (aend:associationend):attribute =
(* size > lowerBound and size < upperBound ) *) (* size > lowerBound and size < upperBound ) *)
fun range_to_inv cls_name aend (a,b) = fun range_to_inv cls_name aend (a,b) =
let val cls = Rep_OclType.Classifier cls_name 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 attr_name = cls_name@[List.last (#name aend)]
val literal_a = Rep_OclTerm.Literal (Int.toString a, Rep_OclType.Integer) val literal_a = Rep_OclTerm.Literal (Int.toString a, Rep_OclType.Integer)
val literal_b = Rep_OclTerm.Literal (Int.toString b, 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 path_of_aend ({name,aend_type,...}:associationend) = name
fun replace_templ_para (Collection(tt)) t = Collection (t) fun substitute_templ_para (Collection(tt)) t = Collection (t)
| replace_templ_para (Set (tt)) t = Set (t) | substitute_templ_para (Set (tt)) t = Set (t)
| replace_templ_para (OrderedSet (tt)) t = OrderedSet (t) | substitute_templ_para (OrderedSet (tt)) t = OrderedSet (t)
| replace_templ_para (Sequence (tt)) t = Sequence (t) | substitute_templ_para (Sequence (tt)) t = Sequence (t)
| replace_templ_para (Bag (tt)) t = Bag (t) | substitute_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") | 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 case typ of
Set(t) => t Set(t) => t
| Sequence(t) => t | Sequence(t) => t
@ -1583,7 +1579,7 @@ fun multiplicity_constraint cls_name (aend:associationend) =
[(0,1)] => [] [(0,1)] => []
| [(1,1)] => let | [(1,1)] => let
val attr_name = cls_name@[List.last (#name aend)] 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 cls = Rep_OclType.Classifier cls_name
val self = Rep_OclTerm.Variable ("self",cls) val self = Rep_OclTerm.Variable ("self",cls)
val attribute = Rep_OclTerm.AttributeCall (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_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) = fun name_of_aend ({name,aend_type,...}:associationend) =
short_name_of_path name short_name_of_path name
@ -1633,7 +1631,6 @@ fun associations_of (Class{name,associations,...}) = associations
associations associations
| associations_of (Primitive{name,associations,...}) = associations | associations_of (Primitive{name,associations,...}) = associations
fun oppositeAendsOfAssociation name allAssociations associationPath = fun oppositeAendsOfAssociation name allAssociations associationPath =
let let
val [association] = List.filter (fn assoc => path_of_association assoc = val [association] = List.filter (fn assoc => path_of_association assoc =
@ -1757,7 +1754,7 @@ fun normalize (all_associations:association list)
in in
Class {name = name, Class {name = name,
parent = parent, parent = parent,
attributes = append (map (aend_to_attr (List.last(path_of_OclType attributes = append (map (convert_aend (List.last(path_of_OclType
name))) name)))
(associationends_of all_associations C)) (associationends_of all_associations C))
attributes, attributes,
@ -1792,7 +1789,7 @@ fun normalize (all_associations:association list)
AssociationClass { AssociationClass {
name = name, name = name,
parent = parent, parent = parent,
attributes = append (map (aend_to_attr (List.last (path_of_OclType attributes = append (map (convert_aend (List.last (path_of_OclType
name))) name)))
(associationends_of all_associations AC)) (associationends_of all_associations AC))
attributes, attributes,
@ -2187,9 +2184,9 @@ fun package_of (Class{name,...}) =
fun classes_of_package pkg (model as (clist,alist)) = fun classes_of_package pkg (model as (clist,alist)) =
List.filter (fn a => package_of a = pkg) clist 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 (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) | p => (hd o rev) p)
fun parent_package_of (Class{parent,...}) = fun parent_package_of (Class{parent,...}) =
@ -2548,9 +2545,9 @@ fun isColl_Type (Set(x)) = true
| isColl_Type (Collection(x)) = true | isColl_Type (Collection(x)) = true
| isColl_Type _ = false | 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,...}) = fun type_of_parent (Class {parent,...}) =
let 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 parent_of C cl = (class_of (parent_name_of C) (cl,[]))
(* fun get_op cl op_name (model:transform_model) =
fun operation_of cl fq_name =
let let
val classname = (rev o tl o rev) fq_name val ops = all_operations_of cl model
val operations = local_operations_of (class_of classname (cl,[]))
val name = (hd o rev) fq_name
in in
SOME(hd (filter (fn a => if ((name_of_op a) = name) List.find (fn a => op_name = name_of_op a) ops
then true else false ) operations ))
end end
*)
fun connected_classifiers_of (all_associations:association list) fun connected_classifiers_of (all_associations:association list)
(C as Class {attributes,associations,...}) (C as Class {attributes,associations,...})
@ -2714,8 +2707,8 @@ fun connected_classifiers_of (all_associations:association list)
fun args_upcastable [] [] model = true fun upcastable_args [] [] model = true
| args_upcastable ((str,typ)::tail) ((term,ttyp)::args) model = | upcastable_args ((str,typ)::tail) ((term,ttyp)::args) model =
let let
val _ = trace low ("must conform to: " ^ (string_of_OclType typ) ^ "\n") val _ = trace low ("must conform to: " ^ (string_of_OclType typ) ^ "\n")
in in
@ -2725,8 +2718,8 @@ fun args_upcastable [] [] model = true
false false
end end
(* not same nuber of arguments *) (* not same nuber of arguments *)
| args_upcastable [x] list model = false | upcastable_args [x] list model = false
| args_upcastable list [x] model = false | upcastable_args list [x] model = false
(* RETURN: (OclTerm * OclType) list *) (* RETURN: (OclTerm * OclType) list *)
fun upcast_args [] [] model = [] fun upcast_args [] [] model = []
@ -2744,7 +2737,7 @@ fun upcast_args [] [] model = []
end end
(* RETURN: OclType *) (* RETURN: OclType *)
fun upcast_res_type t1 t2 model = fun upcast_type t1 t2 model =
if (conforms_to t1 t2 model) if (conforms_to t1 t2 model)
then t2 then t2
else raise UpcastingError ("Result type does not conform \n") else raise UpcastingError ("Result type does not conform \n")
@ -2761,7 +2754,7 @@ fun upcast_op [] source args model =
let let
val _ = trace low ("\nInterfere method : name : '" ^ name_of_op meth ^ "'\n") 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_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 ("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") val _ = trace low ("Return type of method : " ^ string_of_OclType (result_of_op meth) ^ "\n\n")
in in
@ -2786,34 +2779,34 @@ fun upcast_att (class,attr:attribute) source (model:transform_model) =
end end
fun upcast_ae (class,assocend:associationend) source (model:transform_model) = fun upcast_aend (class,assocend:associationend) source (model:transform_model) =
let let
val check_source = conforms_to (type_of_term source) (type_of class) model 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 ("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 in
if check_source then if check_source then
(* billk_tag *) (* billk_tag *)
(* associationend has changed *) (* 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)@[(#name assocend)],convert_aend_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)@[List.last (#name assocend)],convert_aend_type assocend)))
else else
NONE NONE
end end
(* RETURN: OclTerm *) (* 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.") 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 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 | 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 case (upcast_aend (class,assocend) 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 | 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") val _ = trace low ("overloaded attributes/associationends found: " ^ Int.toString (List.length attr_or_assocend_list) ^ "\n")
in in
let 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") val _ = trace low ("\nReturn type of attribute: " ^ string_of_OclType (type_of_term x) ^ "\n\n")
in in
x x
@ -2981,15 +2974,15 @@ fun get_attr_or_assoc source attr_name (model as (classifiers,associations)) =
fun package_of_template_parameter typ = fun package_of_template_parameter typ =
case (typ) of 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) 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) 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) 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) 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) handle NoCollectionTypeError t => package_of_template_parameter t)
| Integer => [OclLibPackage] | Integer => [OclLibPackage]
| String => [OclLibPackage] | String => [OclLibPackage]
@ -3013,7 +3006,7 @@ fun collection_type classifier =
| Bag (T) => true | Bag (T) => true
| x => false | x => false
fun dispatch_collection (selector,typ) = fun create_set (selector,typ) =
case selector of case selector of
"Set" => Set (typ) "Set" => Set (typ)
| "Sequence" => Sequence (typ) | "Sequence" => Sequence (typ)