diff --git a/su4sml/src/wfcpog/refine_constraint.sml b/su4sml/src/wfcpog/refine_constraint.sml index a3e37cf..4a6ffb8 100644 --- a/su4sml/src/wfcpog/refine_constraint.sml +++ b/su4sml/src/wfcpog/refine_constraint.sml @@ -50,8 +50,9 @@ sig val put : T -> WFCPOG.wfpo -> WFCPOG.wfpo val map : (T -> T) -> WFCPOG.wfpo -> WFCPOG.wfpo end + val print_refine_args : RFM_args -> string - val check_syntax : WFCPOG.wfpo -> Rep.Model -> bool + val check_syntax : WFCPOG.wfpo -> Rep.Model -> bool val generate_pos : WFCPOG.wfpo -> Rep.Model -> (Rep_OclType.Path * Rep_OclTerm.OclTerm) list @@ -81,7 +82,7 @@ exception OpGroupError of Rep_Core.operation list * string type RFM_args = { key : int, - rfm_tuples : (Rep_OclType.Path * Rep_OclType.Path) list + rfm_tuple : (Rep_OclType.Path * Rep_OclType.Path) } @@ -89,11 +90,17 @@ type RFM_args = { structure WFCPOG_RFM_Data = WFCPOG_DataFun (struct type T = RFM_args; - val empty = ({key=10,rfm_tuples=[([]:Path,[]:Path)]}); + val empty = ({key=10,rfm_tuple=([]:Path,[]:Path)}); fun copy T = T; fun extend T = T; end); +fun print_refine_args (args:RFM_args) = + let + val tuple = (#rfm_tuple args) + in + (String.concat ["Refine rmf_tuples with args: abstract package = ",(string_of_path (#1 tuple)),", concrete package = ",(string_of_path (#2 tuple)),".\n"]) + end fun rm x [] = [] | rm x [b] = if (x = b) then [] else [b] | rm x (h::tail) = if (x = h) then (rm x tail) else (h::(rm x tail)) @@ -273,20 +280,21 @@ fun check_syntax wfpo (model:Rep.Model as (clist,alist)) = let val _ = trace function_calls ("WFCPOG_Refine_Constraint.check_syntax\n") val data = WFCPOG_RFM_Data.get wfpo - val packages = (#rfm_tuples data) + val packages = (#rfm_tuple data) + val from = (#1 packages) + val to = (#2 packages) val model_packages = all_packages_of_model model - val check = List.all (fn (from,to) => - if (member from model_packages) andalso (member to model_packages) - then check_syntax_help model from to - else - let - val s1 = ("\n\n########################################################\n") - val s2 = ("########################################################\n\n") - val s3 = ("SYNTAX ERROR: check_syntax'\n\n") - val s4 = ("No classifier where found with the package name of the abstract or concrete path.\n") - in - raise WFCPOG.WFCPOG_WFC_FailedException (s1^s2^s3^s4) - end ) packages + val check = if ((member from model_packages) andalso (member to model_packages)) + then check_syntax_help model from to + else + let + val s1 = ("\n\n########################################################\n") + val s2 = ("########################################################\n\n") + val s3 = ("SYNTAX ERROR: check_syntax\n\n") + val s4 = ("No classifier where found with the package name of the abstract or concrete path.\n") + in + raise WFCPOG.WFCPOG_WFC_FailedException (s1^s2^s3^s4) + end val _ = trace function_ends ("WFCPOG_Refine_Constraint.check_syntax\n") in check @@ -362,9 +370,9 @@ fun generate_pos wfpo (model as (clist,alist)) = val _ = trace wgen ("oclLib removed ...\n") val _ = trace wgen ("Extract args ...\n") val rfm_args = WFCPOG_RFM_Data.get wfpo - val to_refine_packages = (#rfm_tuples rfm_args) + val packages = (#rfm_tuple rfm_args) val _ = trace wgen("Args extracted ...\n") - val res = List.concat (List.map (fn (a,b) => refine_package a b model) to_refine_packages) + val res = refine_package (#1 packages) (#2 packages) model val _ = trace function_ends ("WFCPOG_Refine_Constraint.generate_pos\n") in res diff --git a/su4sml/src/wfcpog/taxonomy_consistency.sml b/su4sml/src/wfcpog/taxonomy_consistency.sml index 1c139c0..8715e09 100644 --- a/su4sml/src/wfcpog/taxonomy_consistency.sml +++ b/su4sml/src/wfcpog/taxonomy_consistency.sml @@ -51,7 +51,7 @@ sig val map : (T -> T) -> WFCPOG.wfpo -> WFCPOG.wfpo end - val print_taxonomy_args : TAX_args -> unit + val print_taxonomy_args : TAX_args -> string (** Subconstraint *) val check_depth : WFCPOG.wfpo -> Rep.Model -> bool @@ -95,7 +95,7 @@ end); fun print_taxonomy_args (args:TAX_args) = - print (concat["Taxonomy max_Depth with args: max_depth=\"",Int.toString (#max_depth args)," and key", Int.toString(#key args),"\n\n\n"]) + (concat["Taxonomy max_Depth with args: max_depth=\"",Int.toString (#max_depth args)," and key", Int.toString(#key args),"\n\n\n"]) fun deep_of_classifier x (Class{parent,...}) (model as (clist,alist)) = (case parent of diff --git a/su4sml/src/wfcpog/test-data.sml b/su4sml/src/wfcpog/test-data.sml index 8048ebf..07939dc 100644 --- a/su4sml/src/wfcpog/test-data.sml +++ b/su4sml/src/wfcpog/test-data.sml @@ -41,8 +41,8 @@ val wfc_tax_5 = rename_wfpo "wfc_tax_5" (TAX_Data.put ({key=2,max_depth=5}) wfc_ (** REFINEMENT CONSTRAINT **) val wfc_rfm = get_wfpo supported_wfs "wfc_rfm" val _ = trace high ("............. refinement constraints loaded ...\n") -val wfc_rfm_SC = rename_wfpo "wfc_rfm_SC" (RFM_Data.put ({key=10,rfm_tuples=[(["AbstractSimpleChair04"],["ConcreteSimpleChair02"])]}) wfc_rfm) -val wfc_rfm_SR= rename_wfpo "wfc_rfm_SR" (RFM_Data.put ({key=10,rfm_tuples=[(["AbstractOverriding"],["ConcreteOverriding"])]}) wfc_rfm) +val wfc_rfm_SC = rename_wfpo "wfc_rfm_SC" (RFM_Data.put ({key=10,rfm_tuple=(["AbstractSimpleChair04"],["ConcreteSimpleChair02"])}) wfc_rfm) +val wfc_rfm_SR= rename_wfpo "wfc_rfm_SR" (RFM_Data.put ({key=10,rfm_tuple=(["AbstractOverriding"],["ConcreteOverriding"])}) wfc_rfm) val _ = trace high ("............. refine wfc constraint loaded ...\n") @@ -81,9 +81,9 @@ val _ = trace high ("............. command/query constraints loaded ...\n") (** REFINEMENT CONSTRAINT **) val po_rfm = get_wfpo supported_pos "po_rfm" val _ = trace high ("............. refinement constraints loaded ...\n") -val po_rfm_SC = rename_wfpo "po_rfm_SR" (RFM_Data.put ({key=10,rfm_tuples=[(["AbstractSimpleChair04"],["ConcreteSimpleChair02"])]}) po_rfm) +val po_rfm_SC = rename_wfpo "po_rfm_SR" (RFM_Data.put ({key=10,rfm_tuple=(["AbstractSimpleChair04"],["ConcreteSimpleChair02"])}) po_rfm) val _ = trace high ("............. refine pog constraint loaded ...\n") -val po_rfm_SR = rename_wfpo "po_rfm_SR" (RFM_Data.put ({key=10,rfm_tuples=[(["AbstractOverriding"],["ConcreteOverriding"])]}) po_rfm) +val po_rfm_SR = rename_wfpo "po_rfm_SR" (RFM_Data.put ({key=10,rfm_tuple=(["AbstractOverriding"],["ConcreteOverriding"])}) po_rfm) val _ = trace high ("............. refine pog constraint loaded ...\n") diff --git a/su4sml/src/wfcpog/wfcpog_registry.sml b/su4sml/src/wfcpog/wfcpog_registry.sml index f9003f0..67d7d57 100644 --- a/su4sml/src/wfcpog/wfcpog_registry.sml +++ b/su4sml/src/wfcpog/wfcpog_registry.sml @@ -85,8 +85,6 @@ sig (** Execute a wfc.*) val check_wfc : Rep.Model -> WFCPOG.wfpo -> bool - (** Execute a wfc with verbose output in case of a false wfc. *) - val check_wfc_verbose : Rep.Model -> WFCPOG.wfpo -> bool (** Execute a list of wfcs.*) val check_wfcs : Rep.Model -> WFCPOG.wfpo list -> bool @@ -486,15 +484,6 @@ fun check_wfc model (wfc_sel as WFCPOG.WFPO{identifier,name,description,recommen in res end - -fun check_wfc_verbose model wfc = - check_wfc model wfc - handle WFCPOG_WFC_FailedException s => - let - val _ = trace exce s - in - false - end fun check_wfcs model wfcs = List.all (fn v => (v = true)) (map (check_wfc model) wfcs)