Meaningful type variable names for named wildcards

When generating meta type variables for named wildcards, keep their names
intact. Also, change their names from _a to tw_a when generalising.

compiler/typecheck/TcHsType.lhs

@@ -534,7 +534,7 @@ tc_hs_type hs_ty@(HsTyLit (HsStrTy s)) exp_kind
        ; return (mkStrLitTy s) }
 
 
-tc_hs_type HsWildcardTy (EK k _) = newWildcardTy k
+tc_hs_type HsWildcardTy (EK k _) = newWildcardTy Nothing k
 
 tc_hs_type (HsNamedWildcardTy name) (EK k _) = tcMetaTyVarForNwc name k
 

compiler/typecheck/TcMType.lhs

@@ -333,7 +333,12 @@ newMetaTyVar meta_info kind
                         TauTv True  -> fsLit "tw"
                         TauTv False -> fsLit "t"
                         SigTv       -> fsLit "a"
-        ; details <- newMetaDetails meta_info
+	; newNamedMetaTyVar name meta_info kind }
+
+newNamedMetaTyVar :: Name -> MetaInfo -> Kind -> TcM TcTyVar
+-- Make a new meta tyvar out of thin air
+newNamedMetaTyVar name meta_info kind
+  = do	{ details <- newMetaDetails meta_info
 	; return (mkTcTyVar name kind details) }
 
 cloneMetaTyVar :: TcTyVar -> TcM TcTyVar
@@ -599,12 +604,25 @@ skolemiseUnboundMetaTyVar tv details
                                  -- ie where we are generalising
         ; uniq <- newUnique      -- Remove it from TcMetaTyVar unique land
         ; kind <- zonkTcKind (tyVarKind tv)
-        ; let final_kind = defaultKind kind
-              final_name = mkInternalName uniq (getOccName tv) span
+        ; let tv_name = getOccName tv
+              new_tv_name = if isWildcardVar tv
+                            then generaliseWildcardVarName tv_name
+                            else tv_name
+              final_name = mkInternalName uniq new_tv_name span
+              final_kind = defaultKind kind
               final_tv   = mkTcTyVar final_name final_kind details
 
         ; writeMetaTyVar tv (mkTyVarTy final_tv)
         ; return final_tv }
+  where
+    -- if a wildcard type called _a is generalised, we rename it to tw_a
+    generaliseWildcardVarName :: OccName -> OccName
+    generaliseWildcardVarName name =
+        let nameFS = occNameFS name
+            mkRes newName = mkOccNameFS (occNameSpace name) newName
+        in if headFS nameFS == '_'
+           then mkRes (appendFS (fsLit "tw") nameFS)
+           else mkRes nameFS
 \end{code}
 
 Note [Zonking to Skolem]
@@ -1000,12 +1018,13 @@ zonkTcKind k = zonkTcType k
 
 \begin{code}
 
-newWildcardVar :: Kind -> TcM TcTyVar
-newWildcardVar kind = newMetaTyVar (TauTv True) kind
+newWildcardVar :: Maybe Name -> Kind -> TcM TcTyVar
+newWildcardVar Nothing kind = newMetaTyVar (TauTv True) kind
+newWildcardVar (Just name) kind = newNamedMetaTyVar name (TauTv True) kind
 
-newWildcardTy  :: Kind -> TcM TcType
-newWildcardTy kind = do
-    tc_tyvar <- newWildcardVar kind
+newWildcardTy  :: Maybe Name -> Kind -> TcM TcType
+newWildcardTy name kind = do
+    tc_tyvar <- newWildcardVar name kind
     return (TyVarTy tc_tyvar)
 
 -- Get the meta type variable that will replace the named wildcard
@@ -1019,7 +1038,7 @@ tcMetaTyVarForNwc name k =
      ; nwc_map <- readMutVar nwc_map_ref
      ; case lookupNamedWildcard name nwc_map of -- TODOT check kind?
        Just ty -> return ty
-       Nothing -> do { metaTyVarTy <- newWildcardTy k
+       Nothing -> do { metaTyVarTy <- newWildcardTy (Just name) k
                      ; updMutVar nwc_map_ref (insertNamedWildcard name metaTyVarTy)
                      ; return metaTyVarTy } }
 

compiler/typecheck/TcType.lhs

@@ -475,9 +475,10 @@ pprTcTyVarDetails (MetaTv { mtv_info = info, mtv_untch = untch })
   = pp_info <> brackets (ppr untch)
   where
     pp_info = case info of
-                PolyTv  -> ptext (sLit "poly")
-                TauTv _ -> ptext (sLit "tau")
-                SigTv   -> ptext (sLit "sig")
+                PolyTv      -> ptext (sLit "poly")
+                TauTv True  -> ptext (sLit "tau")
+                TauTv False -> ptext (sLit "twc")
+                SigTv       -> ptext (sLit "sig")
 
 pprUserTypeCtxt :: UserTypeCtxt -> SDoc
 pprUserTypeCtxt (InfSigCtxt n)    = ptext (sLit "the inferred type for") <+> quotes (ppr n)