src/HOL/Tools/ATP/atp_translate.ML
changeset 44771 0e5d4388bbac
parent 44770 3b1b4d805441
child 44772 60ac7b56296a
--- a/src/HOL/Tools/ATP/atp_translate.ML	Wed Sep 07 09:10:41 2011 +0200
+++ b/src/HOL/Tools/ATP/atp_translate.ML	Wed Sep 07 09:10:41 2011 +0200
@@ -702,7 +702,7 @@
 (* The Booleans indicate whether all type arguments should be kept. *)
 datatype type_arg_policy =
   Explicit_Type_Args of bool |
-  Mangled_Type_Args of bool |
+  Mangled_Type_Args |
   No_Type_Args
 
 fun should_drop_arg_type_args (Simple_Types _) = false
@@ -711,10 +711,10 @@
 
 fun type_arg_policy type_enc s =
   if s = type_tag_name then
-    (if polymorphism_of_type_enc type_enc = Mangled_Monomorphic then
-       Mangled_Type_Args
-     else
-       Explicit_Type_Args) false
+    if polymorphism_of_type_enc type_enc = Mangled_Monomorphic then
+      Mangled_Type_Args
+    else
+      Explicit_Type_Args false
   else case type_enc of
     Tags (_, All_Types) => No_Type_Args
   | _ =>
@@ -722,12 +722,10 @@
       if level = No_Types orelse s = @{const_name HOL.eq} orelse
          (s = app_op_name andalso level = Const_Arg_Types) then
         No_Type_Args
+      else if polymorphism_of_type_enc type_enc = Mangled_Monomorphic then
+        Mangled_Type_Args
       else
-        should_drop_arg_type_args type_enc
-        |> (if polymorphism_of_type_enc type_enc = Mangled_Monomorphic then
-              Mangled_Type_Args
-            else
-              Explicit_Type_Args)
+        Explicit_Type_Args (should_drop_arg_type_args type_enc)
     end
 
 (* Make atoms for sorted type variables. *)
@@ -1411,9 +1409,8 @@
            in
              case type_arg_policy type_enc s'' of
                Explicit_Type_Args drop_args => (name, filter_T_args drop_args)
-             | Mangled_Type_Args drop_args =>
-               (mangled_const_name format type_enc (filter_T_args drop_args)
-                                   name, [])
+             | Mangled_Type_Args =>
+               (mangled_const_name format type_enc T_args name, [])
              | No_Type_Args => (name, [])
            end)
         |> (fn (name, T_args) => IConst (name, T, T_args))
@@ -1846,7 +1843,7 @@
         val (s, s') =
           `(make_fixed_const NONE) @{const_name undefined}
           |> (case type_arg_policy type_enc @{const_name undefined} of
-                Mangled_Type_Args _ => mangled_const_name format type_enc [T]
+                Mangled_Type_Args => mangled_const_name format type_enc [T]
               | _ => I)
       in
         Symtab.map_default (s, [])