Fix Trac #959: a long-standing bug in instantiating otherwise-unbound type variables
[ghc-hetmet.git] / compiler / typecheck / TcHsSyn.lhs
index 299d70f..de572ba 100644 (file)
@@ -16,8 +16,6 @@ module TcHsSyn (
        nlHsIntLit, 
        shortCutLit, hsOverLitName,
        
-       mkArbitraryType,        -- Put this elsewhere?
-
        -- re-exported from TcMonad
        TcId, TcIdSet, TcDictBinds,
 
@@ -39,7 +37,6 @@ import TcType
 import TcMType
 import TysPrim
 import TysWiredIn
-import TyCon
 import DataCon
 import Name
 import Var
@@ -52,7 +49,6 @@ import SrcLoc
 import Util
 import Bag
 import Outputable
-import FastString
 \end{code}
 
 \begin{code}
@@ -1012,76 +1008,7 @@ zonkTypeZapping ty
        -- mutable tyvar to a fresh immutable one.  So the mutable store
        -- plays the role of an environment.  If we come across a mutable
        -- type variable that isn't so bound, it must be completely free.
-    zonk_unbound_tyvar tv = do { ty <- mkArbitraryType warn tv
+    zonk_unbound_tyvar tv = do { let ty = anyTypeOfKind (tyVarKind tv)
                               ; writeMetaTyVar tv ty
                               ; return ty }
-       where
-           warn span msg = setSrcSpan span (addWarnTc msg)
-
-
-{-     Note [Strangely-kinded void TyCons]
-       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-       See Trac #959 for more examples
-
-When the type checker finds a type variable with no binding, which
-means it can be instantiated with an arbitrary type, it usually
-instantiates it to Void.  Eg.
-
-       length []
-===>
-       length Void (Nil Void)
-
-But in really obscure programs, the type variable might have a kind
-other than *, so we need to invent a suitably-kinded type.
-
-This commit uses
-       Void for kind *
-       List for kind *->*
-       Tuple for kind *->...*->*
-
-which deals with most cases.  (Previously, it only dealt with
-kind *.)   
-
-In the other cases, it just makes up a TyCon with a suitable kind.  If
-this gets into an interface file, anyone reading that file won't
-understand it.  This is fixable (by making the client of the interface
-file make up a TyCon too) but it is tiresome and never happens, so I
-am leaving it.
-
-Meanwhile I have now fixed GHC to emit a civilized warning.
- -}
-
-mkArbitraryType :: (SrcSpan -> SDoc -> TcRnIf g l a)   -- How to complain
-               -> TcTyVar
-               -> TcRnIf g l Type              -- Used by desugarer too
--- Make up an arbitrary type whose kind is the same as the tyvar.
--- We'll use this to instantiate the (unbound) tyvar.
---
--- Also used by the desugarer; hence the (tiresome) parameter
--- to use when generating a warning
-mkArbitraryType warn tv 
-  | liftedTypeKind `isSubKind` kind            -- The vastly common case
-  = return anyPrimTy
-  | eqKind kind (tyConKind anyPrimTyCon1)      -- @*->*@
-  = return (mkTyConApp anyPrimTyCon1 [])       --     No tuples this size
-  | all isLiftedTypeKind args                  -- @*-> ... ->*->*@
-  , isLiftedTypeKind res                       --    Horrible hack to make less use 
-  = return (mkTyConApp tup_tc [])              --    of mkAnyPrimTyCon
-  | otherwise
-  = do { _ <- warn (getSrcSpan tv) msg
-       ; return (mkTyConApp (mkAnyPrimTyCon (getUnique tv) kind) []) }
-               -- Same name as the tyvar, apart from making it start with a colon (sigh)
-               -- I dread to think what will happen if this gets out into an 
-               -- interface file.  Catastrophe likely.  Major sigh.
-  where
-    kind       = tyVarKind tv
-    (args,res) = splitKindFunTys kind
-    tup_tc     = tupleTyCon Boxed (length args)
-               
-    msg = vcat [ hang (ptext (sLit "Inventing strangely-kinded Any TyCon"))
-                   2 (ptext (sLit "of kind") <+> quotes (ppr kind))
-              , nest 2 (ptext (sLit "from an instantiation of type variable") <+> quotes (ppr tv))
-              , ptext (sLit "This warning can be suppressed by a type signature fixing") <+> quotes (ppr tv)
-              , nest 2 (ptext (sLit "but is harmless without -O (and usually harmless anyway)."))
-              , ptext (sLit "See http://hackage.haskell.org/trac/ghc/ticket/959 for details")  ]
-\end{code}
+\end{code}
\ No newline at end of file