cleaned up taxonomy consistency

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

su4sml/src/wfcpog/taxonomy_consistency.sml

@@ -54,7 +54,7 @@ sig
     val print_taxonomy_args : TAX_args -> unit
 
     (** Subconstraint *)
-    val has_maxDepth   : WFCPOG.wfpo -> Rep.Model -> bool	   
+    val check_depth   : WFCPOG.wfpo -> Rep.Model -> bool	   
 
     exception WFCPOG_TaxonomyError of string
 end
@@ -118,28 +118,35 @@ fun deep_of_classifier x (Class{parent,...}) (model as (clist,alist)) =
   | deep_of_classifier x y model = raise WFCPOG_TaxonomyError ("Only Classes can check for maxDepth.\n")
 
 
-fun has_maxDepth_help depth [] model = true
-  | has_maxDepth_help depth (h::classes) (model as (clist,alist)) = 
+
+fun  check_depth_classifier depth class (model as (clist,alist)) = 
     let 
 	val _ = trace wgen ("look for deep ...\n")
-	val d = deep_of_classifier 0 h model
-	val _ = trace wgen ("deep of classifier " ^ (String.concat (Rep_Core.name_of h)) ^ " = " ^ (Int.toString d) ^ "\n")
+	val d = deep_of_classifier 0 class model
+	val check = 
+	    if (depth  > d) 
+	    then true
+	    else 
+		let
+		    val s1 = "SYNTAX ERROR: Taxonomy design consistency\n\n"
+		    val s2 = "Classifier " ^ (string_of_path (name_of class)) ^ " has depth " ^ (Int.toString (d)) ^ ".\n"
+		in
+		    raise WFCPOG.WFCPOG_WFC_FailedException (s1^s2)
+		end 
     in
-	if (d > depth) 
-	then false
-	else has_maxDepth_help depth classes model
+	check
     end
     
-fun has_maxDepth wfpo (model as (clist,alist)) =
+fun check_depth wfpo (model as (clist,alist)) =
     let
-	val _ = trace wgen ("remove oclLib ...\n")
-	val classes = removeOclLibrary clist
-	val _ = trace wgen ("oclLib removed ...\n")
+	val _ = trace function_calls ("WFCPG_Taxonomy_Consistency.check_maxDepth\n")
+	val cl = removeOclLibrary clist
+	val classes = List.filter (fn a => (is_Class a) orelse (is_AssoClass a) orelse (is_Iface a) orelse (is_Enum a) orelse (is_Primi a)) cl
 	val tax_args = WFCPOG_TAX_Data.get wfpo
-	val _ = trace wgen ("args extracted ...\n")
 	val depth = (#max_depth tax_args)
-	val _ = trace wgen ("depth = " ^ (Int.toString (depth)) ^ "\n")
+	val res = List.all (fn a => a = true) (List.map (fn a => check_depth_classifier depth a model) classes)
+	val _ = trace function_calls ("WFCPG_Taxonomy_Consistency.check_maxDepth\n")
     in
-	has_maxDepth_help depth classes model 
+	res
     end
 end;

su4sml/src/wfcpog/test-data.sml

@@ -120,5 +120,5 @@ val pos = [po_cstr]
 val wfs = [wfc_vis]
 val pos = []
 *)
-val wfs = [wfc_vis_class,wfc_vis_inheritance,wfc_vis_runtime,wfc_vis_design_by_contract,wfc_vis]
+val wfs = [wfc_vis_class]
 val pos = []

su4sml/src/wfcpog/wfcpog_registry.sml

@@ -162,7 +162,7 @@ val tax_workaround =
      recommended     = true,
      depends         = [],
      recommends      = [],
-     apply           = WFCPOG.WFC(WFCPOG_Taxonomy_Constraint.has_maxDepth),
+     apply           = WFCPOG.WFC(WFCPOG_Taxonomy_Constraint.check_depth),
      data            = Datatab.empty 
     }
 		       
@@ -259,7 +259,7 @@ val supported_wfs = [
      recommended     = true,
      depends         = [],
      recommends      = [],
-     apply           = WFCPOG.WFC(WFCPOG_Taxonomy_Constraint.has_maxDepth),
+     apply           = WFCPOG.WFC(WFCPOG_Taxonomy_Constraint.check_depth),
      data            = Datatab.empty 
     }
     ,