git-svn-id: https://projects.brucker.ch/su4sml/svn/su4sml/trunk@7429 3260e6d1-4efc-4170-b0a7-36055960796d
This commit is contained in:
Manuel Krucker
parent
e471416c9f
commit
93bb07e8e5
|
|
@ -50,13 +50,13 @@ structure Command_Query_Constraint:COMMAND_QUERY_CONSTRAINT =
|
|||
struct
|
||||
|
||||
(* su4sml *)
|
||||
open library
|
||||
open Rep_Core
|
||||
open Rep_OclTerm
|
||||
open Rep_OclType
|
||||
open Rep2String
|
||||
|
||||
(* oclparser *)
|
||||
open Ext_Library
|
||||
open ModelImport
|
||||
|
||||
(* wfcpo-gen *)
|
||||
|
|
|
|||
|
|
@ -55,13 +55,13 @@ structure Constructor_Constraint : CONSTRUCTOR_CONSTRAINT =
|
|||
struct
|
||||
|
||||
(* SU4SML *)
|
||||
open library
|
||||
open Rep_Core
|
||||
open Rep
|
||||
open Rep_OclTerm
|
||||
open Rep_OclType
|
||||
|
||||
(* OclParser *)
|
||||
open Ext_Library
|
||||
open ModelImport
|
||||
|
||||
(* WFCPO *)
|
||||
|
|
|
|||
|
|
@ -51,10 +51,10 @@ structure Data_Model_Consistency_Constraint : DATA_MODEL_CONSISTENCY_CONSTRAINT
|
|||
struct
|
||||
|
||||
(* su4sml *)
|
||||
open library
|
||||
open Rep_Core
|
||||
open Rep_OclTerm
|
||||
open Rep_OclType
|
||||
open Ext_Library
|
||||
open ModelImport
|
||||
open Rep2String
|
||||
|
||||
|
|
|
|||
|
|
@ -54,13 +54,13 @@ structure Interface_Constraint:INTERFACE_CONSTRAINT =
|
|||
struct
|
||||
|
||||
(* su4sml *)
|
||||
open library
|
||||
open Rep_Core
|
||||
open Rep_OclTerm
|
||||
open Rep_OclType
|
||||
open Rep2String
|
||||
|
||||
(* oclparser *)
|
||||
open Ext_Library
|
||||
open ModelImport
|
||||
|
||||
(* wfcpo-gen *)
|
||||
|
|
|
|||
|
|
@ -77,30 +77,8 @@ sig
|
|||
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
|
||||
(** Get all query operations of a classifier.*)
|
||||
val query_operations_of : Rep_Core.Classifier -> Rep_Core.operation list
|
||||
(** Get all command operations of a classifier.*)
|
||||
val command_operations_of : Rep_Core.Classifier -> Rep_Core.operation list
|
||||
(** Get the local operations of a classifier.*)
|
||||
val local_operations_of : Rep_OclType.Path -> Rep.Model -> Rep_Core.operation list
|
||||
(** Get the redefined/refined operations of a classifier.*)
|
||||
val modified_operations_of : Rep_OclType.Path -> Rep.Model -> Rep_Core.operation list
|
||||
(** Get all the inherited (without the redefined ones) operations of a classifier.*)
|
||||
val inherited_operations_of : Rep_OclType.Path -> Rep.Model -> Rep_Core.operation list
|
||||
(** Get all operations of a classifier (for redefined ones the more special is choosen).*)
|
||||
val all_operations_of : Rep_OclType.Path -> Rep.Model -> Rep_Core.operation list
|
||||
(** Get all creators of a classifier.*)
|
||||
val creation_operations_of : Rep_OclType.Path -> Rep.Model -> Rep_Core.operation list
|
||||
(** Get all destroying operations of a classifier.*)
|
||||
val destruction_operations_of : Rep_OclType.Path -> Rep.Model -> Rep_Core.operation list
|
||||
(** Get all public operations of a classifier.*)
|
||||
val public_operations_of : Rep_OclType.Path -> Rep.Model -> Rep_Core.operation list
|
||||
(** Get all private operations of a classifier.*)
|
||||
val private_operations_of : Rep_OclType.Path -> Rep.Model -> Rep_Core.operation list
|
||||
(** Get all package operations of a classifier.*)
|
||||
val package_operations_of : Rep_OclType.Path -> Rep.Model -> Rep_Core.operation list
|
||||
(** Get all protected operations of a classifier.*)
|
||||
val protected_operations_of : Rep_OclType.Path -> Rep.Model -> Rep_Core.operation list
|
||||
|
||||
|
||||
|
||||
|
||||
(** Get the class his children *)
|
||||
|
|
@ -128,6 +106,7 @@ structure WFCPOG_Library:WFCPOG_LIBRARY =
|
|||
struct
|
||||
|
||||
(* SU4SML *)
|
||||
open library
|
||||
open Rep_Core
|
||||
open Rep
|
||||
open Rep_OclType
|
||||
|
|
@ -136,7 +115,6 @@ open OclLibrary
|
|||
open Rep2String
|
||||
open XMI_DataTypes
|
||||
(* OclParser *)
|
||||
open Ext_Library
|
||||
|
||||
(* WFCPO-Gen *)
|
||||
open WFCPO_Naming
|
||||
|
|
@ -184,13 +162,7 @@ fun disjugate_terms [] = raise WFCPOG_LibraryError("Empty list not disjugateable
|
|||
end
|
||||
|
||||
(* create normal list from a list of options type *)
|
||||
fun optlist2list [] = []
|
||||
| optlist2list (h::tail) =
|
||||
(
|
||||
case h of
|
||||
NONE => optlist2list (tail)
|
||||
| SOME (e) => (e::(optlist2list tail))
|
||||
)
|
||||
|
||||
|
||||
fun filter_out_none [] = []
|
||||
| filter_out_none (NONE::tail) = filter_out_none tail
|
||||
|
|
@ -198,55 +170,9 @@ fun filter_out_none [] = []
|
|||
|
||||
|
||||
|
||||
(* check whether two given signatures match each other from the type point of view *)
|
||||
fun sig_conforms_to [] [] model = true
|
||||
| sig_conforms_to [] list model =
|
||||
let
|
||||
val result = false
|
||||
in
|
||||
result
|
||||
end
|
||||
| sig_conforms_to list [] model =
|
||||
let
|
||||
val result = false
|
||||
in
|
||||
result
|
||||
end
|
||||
| sig_conforms_to [(s1:string,sig_sub:OclType)] [(s2:string,sig_super:OclType)] model =
|
||||
let
|
||||
val result = if (conforms_to (sig_sub) (sig_super) model) then
|
||||
true
|
||||
else
|
||||
false
|
||||
in
|
||||
result
|
||||
end
|
||||
| sig_conforms_to ((s1:string,sig_sub:OclType)::tail1) ((s2:string,sig_super:OclType)::tail2) model =
|
||||
let
|
||||
val result = if (s2 = s1 andalso (conforms_to (sig_sub) (sig_super) model)) then
|
||||
sig_conforms_to tail1 tail2 model
|
||||
else
|
||||
false
|
||||
in
|
||||
result
|
||||
end
|
||||
|
||||
fun query_operations_of (Class{operations,...}) = List.filter (fn a => (#isQuery a)) operations
|
||||
| query_operations_of (AssociationClass{operations,...}) = List.filter (fn a => (#isQuery a)) operations
|
||||
| query_operations_of (Primitive{operations,...}) = List.filter (fn a => (#isQuery a)) operations
|
||||
| query_operations_of (Interface{operations,...}) = List.filter (fn a => (#isQuery a)) operations
|
||||
| query_operations_of x = []
|
||||
|
||||
fun command_operations_of (Class{operations,...}) = List.filter (fn a => not (#isQuery a)) operations
|
||||
| command_operations_of (AssociationClass{operations,...}) = List.filter (fn a => not (#isQuery a)) operations
|
||||
| command_operations_of (Primitive{operations,...}) = List.filter (fn a => not (#isQuery a)) operations
|
||||
| command_operations_of (Interface{operations,...}) = List.filter (fn a => not (#isQuery a)) operations
|
||||
| command_operations_of x = []
|
||||
|
||||
fun same_op (sub_op:operation) (super_op:operation) (model:Model) =
|
||||
if ((name_of_op sub_op = name_of_op super_op ) andalso (sig_conforms_to (arguments_of_op sub_op) (arguments_of_op super_op) model))
|
||||
then true
|
||||
else false
|
||||
|
||||
|
||||
fun class_contains_op oper model classifier =
|
||||
|
|
@ -261,12 +187,6 @@ fun class_contains_op oper model classifier =
|
|||
|
||||
|
||||
(* get all local operations of a classifier *)
|
||||
and local_operations_of c_name model =
|
||||
let
|
||||
val class = class_of_type (path_to_type c_name) model
|
||||
in
|
||||
(operations_of class)
|
||||
end
|
||||
|
||||
fun class_has_local_op name model classifier =
|
||||
let
|
||||
|
|
@ -276,111 +196,9 @@ fun class_has_local_op name model classifier =
|
|||
end
|
||||
|
||||
|
||||
fun embed_local_operation oper [] model = [oper]
|
||||
| embed_local_operation lop ((oper:operation)::iops) model =
|
||||
if (same_op lop oper model)
|
||||
then (lop::iops)
|
||||
else (oper)::(embed_local_operation lop iops model)
|
||||
|
||||
(* embed local operations to the inherited operations *)
|
||||
fun embed_local_operations [] iops model = iops
|
||||
| embed_local_operations x [] model = x
|
||||
| embed_local_operations (h::tail) iops model =
|
||||
let
|
||||
val tmp = embed_local_operation h iops model
|
||||
in
|
||||
(embed_local_operations tail tmp model)
|
||||
end
|
||||
|
||||
(* get all inherited operations of a classifier, without the local operations *)
|
||||
fun inherited_operations_of c_name (model as (clist,alist)) =
|
||||
let
|
||||
val class = class_of_type (path_to_type c_name) model
|
||||
val _ = trace 50 ("inh ops 1: classifier = " ^ (classifier2string class) ^ "\n")
|
||||
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 _ = trace 50 ("inh ops 3\n")
|
||||
val ops_of_par = (List.map (operations_of) c_parents)
|
||||
val _ = trace 50 ("inh ops 4\n")
|
||||
in
|
||||
List.foldr (fn (a,b) => embed_local_operations a b model) (List.last (ops_of_par)) ops_of_par
|
||||
end
|
||||
|
||||
(* get absolutelly all operations of a classifier. In case of a functions which occurs serveral times in the inheritance tree, the must specified function is listed. *)
|
||||
fun all_operations_of c_name model =
|
||||
let
|
||||
val lo = local_operations_of c_name model
|
||||
val _ = trace 50 ("all ops 1\n")
|
||||
val io = inherited_operations_of c_name model
|
||||
val _ = trace 50 ("all ops 2\n")
|
||||
in
|
||||
embed_local_operations lo io model
|
||||
end
|
||||
|
||||
(* get all local operations, which occurs in one of the parent classes at least each time also *)
|
||||
fun modified_operations_of c_name model =
|
||||
let
|
||||
val io = inherited_operations_of c_name model
|
||||
val lo = local_operations_of c_name model
|
||||
fun op_exists (oper:operation) [] = false
|
||||
| op_exists (oper:operation) ((h:operation)::tail) = if (oper=h)
|
||||
then true
|
||||
else op_exists oper tail
|
||||
in
|
||||
optlist2list (List.map (fn a => if (op_exists a io)
|
||||
then NONE
|
||||
else (if (List.exists (fn b => same_op a b model) io)
|
||||
then SOME(a)
|
||||
else NONE
|
||||
)) lo)
|
||||
(* List.concat (List.map (fn a => List.filter (fn b => if (same_op a b model) then false else true) io) lo ) *)
|
||||
end
|
||||
|
||||
|
||||
fun creation_operations_of c_name (model:Rep.Model) =
|
||||
let
|
||||
val oper = all_operations_of c_name model
|
||||
val creators = List.filter (fn a => List.exists (fn b => b = "create") (#stereotypes a)) (oper)
|
||||
in
|
||||
creators
|
||||
end
|
||||
|
||||
fun destruction_operations_of c_name (model:Rep.Model) =
|
||||
let
|
||||
val oper = all_operations_of c_name model
|
||||
val creators = List.filter (fn a => List.exists (fn b => b = "destroy") (#stereotypes a)) (oper)
|
||||
in
|
||||
creators
|
||||
end
|
||||
|
||||
fun public_operations_of c_name (model:Rep.Model) =
|
||||
let
|
||||
val ops = all_operations_of c_name model
|
||||
in
|
||||
List.filter (fn a => (#visibility a) = public) ops
|
||||
end
|
||||
|
||||
fun private_operations_of c_name (model:Rep.Model) =
|
||||
let
|
||||
val ops = all_operations_of c_name model
|
||||
in
|
||||
List.filter (fn a => (#visibility a) = private) ops
|
||||
end
|
||||
|
||||
fun package_operations_of c_name (model:Rep.Model) =
|
||||
let
|
||||
val ops = all_operations_of c_name model
|
||||
in
|
||||
List.filter (fn a => (#visibility a) = package) ops
|
||||
end
|
||||
|
||||
fun protected_operations_of c_name (model:Rep.Model) =
|
||||
let
|
||||
val ops = all_operations_of c_name model
|
||||
in
|
||||
List.filter (fn a => (#visibility a) = protected) ops
|
||||
end
|
||||
|
||||
|
||||
fun get_operation s classifier model =
|
||||
|
|
|
|||
|
|
@ -68,13 +68,13 @@ struct
|
|||
|
||||
exception WFCPOG_LiskovError of string
|
||||
(* su4sml *)
|
||||
open library
|
||||
open Rep_Core
|
||||
open Rep_OclTerm
|
||||
open Rep_OclType
|
||||
open Rep2String
|
||||
|
||||
(* oclparser *)
|
||||
open Ext_Library
|
||||
open ModelImport
|
||||
|
||||
(* wfcpo-gen *)
|
||||
|
|
|
|||
|
|
@ -1,26 +1,27 @@
|
|||
(* open structures *)
|
||||
|
||||
(* SU4SML *)
|
||||
open library
|
||||
open OclLibrary
|
||||
open ModelImport
|
||||
open Rep_Core
|
||||
open Ext_Library
|
||||
|
||||
|
||||
(* WFCPO-GEN *)
|
||||
open WFCPO_Library
|
||||
open WFCPOG_Library
|
||||
|
||||
|
||||
(* set debugging settings *)
|
||||
val _ = Control.Print.printDepth:=20
|
||||
val _ = Control.Print.printLength:=30
|
||||
(*
|
||||
val zargo = "../../../stack_manu/stack.zargo"
|
||||
val ocl = "../../../stack_manu/stack.ocl"
|
||||
*)
|
||||
|
||||
val zargo = "../../../examples/stack_manu/stack.zargo"
|
||||
val ocl = "../../../examples/stack_manu/stack.ocl"
|
||||
|
||||
(*
|
||||
val zargo = "../../../examples/ebank/ebank.zargo"
|
||||
val ocl="../../../examples/ebank/ebank.ocl"
|
||||
|
||||
*)
|
||||
(** import model *)
|
||||
val i_model = import zargo ocl []
|
||||
val (clist,alist) = normalize_ext i_model
|
||||
|
|
|
|||
|
|
@ -58,13 +58,13 @@ struct
|
|||
|
||||
|
||||
(* SU4SML *)
|
||||
open library
|
||||
open Rep_Core
|
||||
open Rep
|
||||
open Rep_OclTerm
|
||||
open Rep_OclType
|
||||
|
||||
(* OclParser *)
|
||||
open Ext_Library
|
||||
open ModelImport
|
||||
|
||||
(* WFCPO *)
|
||||
|
|
|
|||
|
|
@ -26,14 +26,12 @@ structure Refine_Constraint : REFINE_CONSTRAINT =
|
|||
struct
|
||||
|
||||
(* su4sml *)
|
||||
open library
|
||||
open Rep_Core
|
||||
open Rep_OclTerm
|
||||
open Rep_OclType
|
||||
open Rep2String
|
||||
|
||||
(* ocl-parser *)
|
||||
open Ext_Library
|
||||
|
||||
(* wfcpo-gen *)
|
||||
open WFCPOG_Library
|
||||
|
||||
|
|
@ -160,7 +158,7 @@ fun map_types [] fP tP model = []
|
|||
(* relative path of return type *)
|
||||
val new_path = substitute_package fP tP ret_namefC
|
||||
val _ = trace zero ("map_types_5: name of return type: " ^ string_of_path (ret_namefC) ^ "\n")
|
||||
val c1 = class_of (new_path) (#1 model)
|
||||
val c1 = class_of (new_path) (model)
|
||||
handle _ =>
|
||||
let
|
||||
val _ = trace exce ("\n\n#####################################################################\n")
|
||||
|
|
@ -182,7 +180,7 @@ fun map_types [] fP tP model = []
|
|||
let
|
||||
val rel_path = substitute_package fP tP a
|
||||
in
|
||||
class_of (rel_path) (#1 model)
|
||||
class_of (rel_path) (model)
|
||||
handle _ =>
|
||||
let
|
||||
val _ = trace exce ("\n\n#####################################################################\n")
|
||||
|
|
|
|||
|
|
@ -63,6 +63,7 @@ structure Taxonomy_Constraint:TAXONOMY_CONSTRAINT =
|
|||
struct
|
||||
|
||||
(* su4sml *)
|
||||
open library
|
||||
open Rep_Core
|
||||
open Rep_OclTerm
|
||||
open Rep_OclType
|
||||
|
|
@ -70,7 +71,6 @@ open Rep2String
|
|||
open XMI_DataTypes
|
||||
|
||||
(* oclparser *)
|
||||
open Ext_Library
|
||||
open ModelImport
|
||||
|
||||
(* wfcpo-gen *)
|
||||
|
|
|
|||
|
|
@ -51,6 +51,7 @@ structure Visibility_Constraint:VISIBILITY_CONSTRAINT =
|
|||
struct
|
||||
|
||||
(* su4sml *)
|
||||
open library
|
||||
open Rep_Core
|
||||
open Rep_OclTerm
|
||||
open Rep_OclType
|
||||
|
|
@ -58,7 +59,6 @@ open Rep2String
|
|||
open XMI_DataTypes
|
||||
|
||||
(* oclparser *)
|
||||
open Ext_Library
|
||||
open ModelImport
|
||||
|
||||
(* wfcpo-gen *)
|
||||
|
|
@ -99,7 +99,7 @@ and is_modificator_conformant modif (Literal(s,typ)) model = true
|
|||
andalso is_modificator_conformant modif then_t model
|
||||
| is_modificator_conformant modif (AssociationEndCall(src,styp,path,rtyp)) model =
|
||||
let
|
||||
val cl = get_classifier src model
|
||||
val cl = class_of_term src model
|
||||
val att_name = List.last(path)
|
||||
val att = get_attribute att_name cl model
|
||||
val _ = trace 100 ("end is_modificator_conformant")
|
||||
|
|
@ -111,7 +111,7 @@ and is_modificator_conformant modif (Literal(s,typ)) model = true
|
|||
| is_modificator_conformant modif (x as OperationCall(src,styp,path,args,rtyp)) model =
|
||||
let
|
||||
val typ = type_of_term src
|
||||
val cl = get_classifier (Variable("x",typ)) model
|
||||
val cl = class_of_term (Variable("x",typ)) model
|
||||
val op_name = List.last(path)
|
||||
val _ = trace 100 ("OperationCall: " ^ (Ocl2String.ocl2string false x) ^ "\n")
|
||||
val _ = trace 100 ("Classifier : " ^ Rep2String.classifier2string cl ^ "\n")
|
||||
|
|
@ -125,7 +125,7 @@ and is_modificator_conformant modif (Literal(s,typ)) model = true
|
|||
end
|
||||
| is_modificator_conformant modif (x as AttributeCall(src,styp,path,rtyp)) model =
|
||||
let
|
||||
val cl = get_classifier src model
|
||||
val cl = class_of_term src model
|
||||
val att_name = List.last(path)
|
||||
val att = get_attribute att_name cl model
|
||||
val _ = trace 100 ("end is_modificator_conformant")
|
||||
|
|
|
|||
|
|
@ -72,7 +72,7 @@ structure LSK_Data = Liskov_Constraint.LSK_Data
|
|||
structure TAX_Data = Taxonomy_Constraint.TAX_Data
|
||||
structure RFM_Data = Refine_Constraint.RFM_Data
|
||||
|
||||
open Ext_Library
|
||||
open library
|
||||
open WFCPOG
|
||||
|
||||
val wfpos = ref ([]:(WFCPOG.wfpo list))
|
||||
|
|
|
|||
Loading…
Reference in New Issue