tuning terminology
authorblanchet
Wed, 06 Jun 2012 10:35:05 +0200
changeset 48095 bb836e77f590
parent 48094 c3d4f4d9e54c
child 48096 60a09522c65e
tuning terminology
src/HOL/Tools/ATP/atp_problem_generate.ML
--- a/src/HOL/Tools/ATP/atp_problem_generate.ML	Wed Jun 06 10:35:05 2012 +0200
+++ b/src/HOL/Tools/ATP/atp_problem_generate.ML	Wed Jun 06 10:35:05 2012 +0200
@@ -24,7 +24,7 @@
 
   datatype polymorphism = Polymorphic | Raw_Monomorphic | Mangled_Monomorphic
   datatype strictness = Strict | Non_Strict
-  datatype granularity = All_Vars | Positively_Naked_Vars | Ghost_Type_Arg_Vars
+  datatype granularity = All_Vars | Positively_Naked_Vars | Undercover_Vars
   datatype type_level =
     All_Types |
     Nonmono_Types of strictness * granularity |
@@ -128,7 +128,7 @@
   Higher_Order of thf_choice
 datatype polymorphism = Polymorphic | Raw_Monomorphic | Mangled_Monomorphic
 datatype strictness = Strict | Non_Strict
-datatype granularity = All_Vars | Positively_Naked_Vars | Ghost_Type_Arg_Vars
+datatype granularity = All_Vars | Positively_Naked_Vars | Undercover_Vars
 datatype type_level =
   All_Types |
   Nonmono_Types of strictness * granularity |
@@ -622,7 +622,7 @@
              SOME s => (Nonmono_Types (strictness, Positively_Naked_Vars), s)
            | NONE =>
              case try_unsuffixes ats s of
-               SOME s => (Nonmono_Types (strictness, Ghost_Type_Arg_Vars), s)
+               SOME s => (Nonmono_Types (strictness, Undercover_Vars), s)
              | NONE => (Nonmono_Types (strictness, All_Vars), s))
          | NONE => (All_Types, s))
   |> (fn (poly, (level, core)) =>
@@ -651,12 +651,12 @@
             | _ => raise Same.SAME)
          | ("guards", (SOME poly, _)) =>
            if poly = Mangled_Monomorphic andalso
-              granularity_of_type_level level = Ghost_Type_Arg_Vars then
+              granularity_of_type_level level = Undercover_Vars then
              raise Same.SAME
            else
              Guards (poly, level)
          | ("tags", (SOME poly, _)) =>
-           if granularity_of_type_level level = Ghost_Type_Arg_Vars then
+           if granularity_of_type_level level = Undercover_Vars then
              raise Same.SAME
            else
              Tags (poly, level)
@@ -849,7 +849,7 @@
         else if poly = Mangled_Monomorphic then
           Mangled_Type_Args
         else if level = All_Types orelse
-                granularity_of_type_level level = Ghost_Type_Arg_Vars then
+                granularity_of_type_level level = Undercover_Vars then
           Noninferable_Type_Args
         else if member (op =) constrs s andalso level <> Const_Types false then
           Constr_Type_Args
@@ -1362,7 +1362,7 @@
                              maybe_nonmono_Ts, ...}
                        (Nonmono_Types (strictness, grain)) T =
     let val thy = Proof_Context.theory_of ctxt in
-      grain = Ghost_Type_Arg_Vars orelse
+      grain = Undercover_Vars orelse
       (exists (type_intersect thy T) maybe_nonmono_Ts andalso
        not (exists (type_instance thy T) surely_infinite_Ts orelse
             (not (member (type_equiv thy) maybe_finite_Ts T) andalso
@@ -1943,30 +1943,31 @@
     accum orelse (is_tptp_equal s andalso member (op =) tms (ATerm (name, [])))
   | is_var_positively_naked_in_term _ _ _ _ = true
 
-fun is_var_ghost_type_arg_in_term thy name pos tm accum =
+fun is_var_positively_naked_or_undercover_in_term thy name pos tm accum =
   is_var_positively_naked_in_term name pos tm accum orelse
   let
     val var = ATerm (name, [])
-    fun is_nasty_in_term (ATerm (_, [])) = false
-      | is_nasty_in_term (ATerm ((s, _), tms)) =
+    fun is_undercover (ATerm (_, [])) = false
+      | is_undercover (ATerm ((s, _), tms)) =
         let
           val ary = length tms
           val cover = type_arg_cover thy s ary
         in
           exists (fn (j, tm) => tm = var andalso member (op =) cover j)
                  (0 upto ary - 1 ~~ tms) orelse
-          exists is_nasty_in_term tms
+          exists is_undercover tms
         end
-      | is_nasty_in_term _ = true
-  in is_nasty_in_term tm end
+      | is_undercover _ = true
+  in is_undercover tm end
 
 fun should_guard_var_in_formula thy level pos phi (SOME true) name =
     (case granularity_of_type_level level of
        All_Vars => true
      | Positively_Naked_Vars =>
        formula_fold pos (is_var_positively_naked_in_term name) phi false
-     | Ghost_Type_Arg_Vars =>
-       formula_fold pos (is_var_ghost_type_arg_in_term thy name) phi false)
+     | Undercover_Vars =>
+       formula_fold pos (is_var_positively_naked_or_undercover_in_term thy name)
+                    phi false)
   | should_guard_var_in_formula _ _ _ _ _ _ = true
 
 fun always_guard_var_in_formula _ _ _ _ _ _ = true
@@ -2294,7 +2295,7 @@
   let val level = level_of_type_enc type_enc in
     [] |> (polymorphism_of_type_enc type_enc = Polymorphic andalso
            is_type_level_monotonicity_based level andalso
-           granularity_of_type_level level <> Ghost_Type_Arg_Vars)
+           granularity_of_type_level level <> Undercover_Vars)
           ? fold (add_fact_monotonic_types ctxt mono type_enc) facts
   end
 
@@ -2405,7 +2406,7 @@
       if should_encode res_T then
         let
           val tagged_bounds =
-            if grain = Ghost_Type_Arg_Vars then
+            if grain = Undercover_Vars then
               let val cover = type_arg_cover thy s ary in
                 map2 (fn (j, arg_T) => member (op =) cover j ? tag_with arg_T)
                      (0 upto ary - 1 ~~ arg_Ts) bounds