Clean up the debugger code

[ghc-hetmet.git] / compiler / typecheck / TcType.lhs

diff --git a/compiler/typecheck/TcType.lhs b/compiler/typecheck/TcType.lhs
index 0025a5e..194deb9 100644 (file)
--- a/compiler/typecheck/TcType.lhs
+++ b/compiler/typecheck/TcType.lhs
@@ -123,7 +123,8 @@ module TcType (
   -- Type substitutions
   TvSubst(..),         -- Representation visible to a few friends
   TvSubstEnv, emptyTvSubst, substEqSpec,
-  mkOpenTvSubst, zipOpenTvSubst, zipTopTvSubst, mkTopTvSubst, notElemTvSubst,
+  mkOpenTvSubst, zipOpenTvSubst, zipTopTvSubst, 
+  mkTopTvSubst, notElemTvSubst, unionTvSubst,
   getTvSubstEnv, setTvSubstEnv, getTvInScope, extendTvInScope, lookupTyVar,
   extendTvSubst, extendTvSubstList, isInScope, mkTvSubst, zipTyEnv,
   substTy, substTys, substTyWith, substTheta, substTyVar, substTyVars, substTyVarBndr,
@@ -274,17 +275,18 @@ TcBinds.tcInstSig, and its use_skols parameter.
 data TcTyVarDetails
   = SkolemTv SkolemInfo          -- A skolem constant
 
-  | FlatSkol TcType      -- The "skolem" obtained by flattening during
-                         -- constraint simplification
+  | FlatSkol TcType      
+           -- The "skolem" obtained by flattening during
+          -- constraint simplification
     
-                          -- In comments we will use the notation alpha[flat = ty]
-                          -- to represent a flattening skolem variable alpha
-                          -- identified with type ty.
-
+           -- In comments we will use the notation alpha[flat = ty]
+           -- to represent a flattening skolem variable alpha
+           -- identified with type ty.
+          
   | MetaTv MetaInfo (IORef MetaDetails)
 
 data MetaDetails
-  = Flexi      -- Flexi type variables unify to become Indirects  
+  = Flexi  -- Flexi type variables unify to become Indirects  
   | Indirect TcType
 
 data MetaInfo 
@@ -301,6 +303,11 @@ data MetaInfo
                   -- The Name is the name of the function from whose
                   -- type signature we got this skolem
 
+   | TcsTv        -- A MetaTv allocated by the constraint solver
+                  -- Its particular property is that it is always "touchable"
+                  -- Nevertheless, the constraint solver has to try to guess
+                  -- what type to instantiate it to
+
 ----------------------------------
 -- SkolemInfo describes a site where 
 --   a) type variables are skolemised
@@ -405,8 +412,9 @@ kind_var_occ = mkOccName tvName "k"
 pprTcTyVarDetails :: TcTyVarDetails -> SDoc
 -- For debugging
 pprTcTyVarDetails (SkolemTv _)         = ptext (sLit "sk")
-pprTcTyVarDetails (FlatSkol _)         = ptext (sLit "fsk")
+pprTcTyVarDetails (FlatSkol {})        = ptext (sLit "fsk")
 pprTcTyVarDetails (MetaTv TauTv _)     = ptext (sLit "tau")
+pprTcTyVarDetails (MetaTv TcsTv _)     = ptext (sLit "tcs")
 pprTcTyVarDetails (MetaTv (SigTv _) _) = ptext (sLit "sig")
 
 pprUserTypeCtxt :: UserTypeCtxt -> SDoc
@@ -431,9 +439,10 @@ pprSkolTvBinding tv
     quotes (ppr tv) <+> ppr_details (tcTyVarDetails tv)
   where
     ppr_details (SkolemTv info)      = ppr_skol info
-    ppr_details (FlatSkol _)        = ptext (sLit "is a flattening type variable")
-    ppr_details (MetaTv TauTv _)     = ptext (sLit "is a meta type variable")
-    ppr_details (MetaTv (SigTv n) _) = ptext (sLit "is bound by the type signature for") <+> quotes (ppr n)
+    ppr_details (FlatSkol {})       = ptext (sLit "is a flattening type variable")
+    ppr_details (MetaTv (SigTv n) _) = ptext (sLit "is bound by the type signature for")
+                                       <+> quotes (ppr n)
+    ppr_details (MetaTv _ _)         = ptext (sLit "is a meta type variable")
 
     ppr_skol UnkSkol       = ptext (sLit "is an unknown type variable")        -- Unhelpful
     ppr_skol RuntimeUnkSkol = ptext (sLit "is an unknown runtime type")
@@ -614,8 +623,8 @@ isTyConableTyVar tv
        -- not a SigTv
   = ASSERT( isTcTyVar tv) 
     case tcTyVarDetails tv of
-       MetaTv TauTv _ -> True
-       _              -> False
+       MetaTv (SigTv _) _ -> False
+       _                  -> True
        
 isSkolemTyVar tv 
   = ASSERT2( isTcTyVar tv, ppr tv )
@@ -1416,7 +1425,7 @@ legalFFITyCon tc
 
 marshalableTyCon :: DynFlags -> TyCon -> Bool
 marshalableTyCon dflags tc
-  =  (dopt Opt_UnliftedFFITypes dflags 
+  =  (xopt Opt_UnliftedFFITypes dflags 
       && isUnLiftedTyCon tc
       && not (isUnboxedTupleTyCon tc)
       && case tyConPrimRep tc of       -- Note [Marshalling VoidRep]
@@ -1442,7 +1451,7 @@ legalFIPrimArgTyCon :: DynFlags -> TyCon -> Bool
 -- Strictly speaking it is unnecessary to ban unboxed tuples here since
 -- currently they're of the wrong kind to use in function args anyway.
 legalFIPrimArgTyCon dflags tc
-  = dopt Opt_UnliftedFFITypes dflags
+  = xopt Opt_UnliftedFFITypes dflags
     && isUnLiftedTyCon tc
     && not (isUnboxedTupleTyCon tc)
 
@@ -1450,7 +1459,7 @@ legalFIPrimResultTyCon :: DynFlags -> TyCon -> Bool
 -- Check result type of 'foreign import prim'. Allow simple unlifted
 -- types and also unboxed tuple result types '... -> (# , , #)'
 legalFIPrimResultTyCon dflags tc
-  = dopt Opt_UnliftedFFITypes dflags
+  = xopt Opt_UnliftedFFITypes dflags
     && isUnLiftedTyCon tc
     && (isUnboxedTupleTyCon tc
         || case tyConPrimRep tc of     -- Note [Marshalling VoidRep]