X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcMType.lhs;h=d45d774cda04d6ba1818315cabd9ed9e2d7088f1;hp=f3485a26cfe1b619761f2034feebb2634e3f73c9;hb=a40f2735958055f7ff94e5df73e710044aa63b2c;hpb=71de34ed68265e4f950bd2d43d1f2e955de8b959

diff --git a/compiler/typecheck/TcMType.lhs b/compiler/typecheck/TcMType.lhs
index f3485a2..d45d774 100644
--- a/compiler/typecheck/TcMType.lhs
+++ b/compiler/typecheck/TcMType.lhs
@@ -50,7 +50,7 @@ module TcMType (
   --------------------------------
   -- Zonking
   zonkType, mkZonkTcTyVar, zonkTcPredType, 
-  zonkTcTypeCarefully,
+  zonkTcTypeCarefully, skolemiseUnboundMetaTyVar,
   zonkTcTyVar, zonkTcTyVars, zonkTcTyVarsAndFV, zonkSigTyVar,
   zonkQuantifiedTyVar, zonkQuantifiedTyVars,
   zonkTcType, zonkTcTypes, zonkTcThetaType,
@@ -134,17 +134,6 @@ newWantedEvVars theta = mapM newWantedEvVar theta
 newWantedCoVar :: TcType -> TcType -> TcM CoVar 
 newWantedCoVar ty1 ty2 = newCoVar ty1 ty2
 
--- We used to create a mutable co-var
-{-
--- A wanted coercion variable is a MetaTyVar
--- that can be filled in with its binding
-  = do { uniq <- newUnique 
-       ; ref <- newMutVar Flexi 
-       ; let name = mkSysTvName uniq (fsLit "c")
-             kind = mkPredTy (EqPred ty1 ty2) 
-       ; return (mkTcTyVar name kind (MetaTv TauTv ref)) }
--}
-
 --------------
 newEvVar :: TcPredType -> TcM EvVar
 -- Creates new *rigid* variables for predicates
@@ -488,10 +477,10 @@ zonkTcTypeCarefully ty
       | otherwise
       = ASSERT( isTcTyVar tv )
     	case tcTyVarDetails tv of
-    	  SkolemTv {}    -> return (TyVarTy tv)
+    	  SkolemTv {}  -> return (TyVarTy tv)
     	  FlatSkol ty  -> zonkType (zonk_tv env_tvs) ty
-    	  MetaTv _ ref   -> do { cts <- readMutVar ref
-			       ; case cts of    
+    	  MetaTv _ ref -> do { cts <- readMutVar ref
+		             ; case cts of    
 			           Flexi       -> return (TyVarTy tv)
 			           Indirect ty -> zonkType (zonk_tv env_tvs) ty }
 
@@ -504,11 +493,11 @@ zonkTcTyVar :: TcTyVar -> TcM TcType
 zonkTcTyVar tv
   = ASSERT2( isTcTyVar tv, ppr tv )
     case tcTyVarDetails tv of
-      SkolemTv {}    -> return (TyVarTy tv)
+      SkolemTv {}  -> return (TyVarTy tv)
       FlatSkol ty  -> zonkTcType ty
-      MetaTv _ ref   -> do { cts <- readMutVar ref
-			   ; case cts of    
-			       Flexi       -> return (TyVarTy tv)
+      MetaTv _ ref -> do { cts <- readMutVar ref
+		         ; case cts of    
+		               Flexi       -> return (TyVarTy tv)
 			       Indirect ty -> zonkTcType ty }
 
 zonkTcTypeAndSubst :: TvSubst -> TcType -> TcM TcType
@@ -548,8 +537,6 @@ zonkQuantifiedTyVars :: [TcTyVar] -> TcM [TcTyVar]
 zonkQuantifiedTyVars = mapM zonkQuantifiedTyVar
 
 zonkQuantifiedTyVar :: TcTyVar -> TcM TcTyVar
--- zonkQuantifiedTyVar is applied to the a TcTyVar when quantifying over it.
---
 -- The quantified type variables often include meta type variables
 -- we want to freeze them into ordinary type variables, and
 -- default their kind (e.g. from OpenTypeKind to TypeKind)
@@ -560,35 +547,39 @@ zonkQuantifiedTyVar :: TcTyVar -> TcM TcTyVar
 --
 -- We leave skolem TyVars alone; they are immutable.
 zonkQuantifiedTyVar tv
-  | ASSERT2( isTcTyVar tv, ppr tv ) 
-    isSkolemTyVar tv 
-  = do { kind <- zonkTcType (tyVarKind tv)
-       ; return $ setTyVarKind tv kind
-       }
+  = ASSERT2( isTcTyVar tv, ppr tv ) 
+    case tcTyVarDetails tv of
+      FlatSkol {} -> pprPanic "zonkQuantifiedTyVar" (ppr tv)
+      SkolemTv {} -> do { kind <- zonkTcType (tyVarKind tv)
+                        ; return $ setTyVarKind tv kind }
 	-- It might be a skolem type variable, 
 	-- for example from a user type signature
 
-  | otherwise	-- It's a meta-type-variable
-  = do	{ details <- readMetaTyVar tv
-
-	-- Create the new, frozen, skolem type variable
-        -- We zonk to a skolem, not to a regular TcVar
-        -- See Note [Zonking to Skolem]
-        ; uniq <- newUnique  -- Remove it from TcMetaTyVar unique land
+      MetaTv _ _ref -> 
+#ifdef DEBUG               
+			-- [Sept 04] Check for non-empty.  
+		 	-- See note [Silly Type Synonym]
+                      (readMutVar _ref >>= \cts -> 
+                       case cts of 
+                             Flexi -> return ()
+                             Indirect ty -> WARN( True, ppr tv $$ ppr ty ) 
+                                            return ()) >>
+#endif
+                      skolemiseUnboundMetaTyVar UnkSkol tv 
+                             
+skolemiseUnboundMetaTyVar :: SkolemInfo -> TcTyVar -> TcM TyVar
+-- We have a Meta tyvar with a ref-cell inside it
+-- Skolemise it, including giving it a new Name, so that
+--   we are totally out of Meta-tyvar-land
+-- We create a skolem TyVar, not a regular TyVar
+--   See Note [Zonking to Skolem]
+skolemiseUnboundMetaTyVar skol_info tv
+  = ASSERT2( isMetaTyVar tv, ppr tv ) 
+    do	{ uniq <- newUnique  -- Remove it from TcMetaTyVar unique land
 	; let final_kind = defaultKind (tyVarKind tv)
               final_name = setNameUnique (tyVarName tv) uniq
-	      final_tv   = mkSkolTyVar final_name final_kind UnkSkol
-
-	-- Bind the meta tyvar to the new tyvar
-	; case details of
-	    Indirect ty -> WARN( True, ppr tv $$ ppr ty ) 
-			   return ()
-		-- [Sept 04] I don't think this should happen
-		-- See note [Silly Type Synonym]
-
-	    Flexi -> writeMetaTyVar tv (mkTyVarTy final_tv)
-
-	-- Return the new tyvar
+	      final_tv   = mkSkolTyVar final_name final_kind skol_info
+	; writeMetaTyVar tv (mkTyVarTy final_tv)
 	; return final_tv }
 \end{code}
 
@@ -693,10 +684,8 @@ simplifier knows how to deal with.
 -- For tyvars bound at a for-all, zonkType zonks them to an immutable
 --	type variable and zonks the kind too
 
-zonkType :: (TcTyVar -> TcM Type) 	-- What to do with unbound mutable type variables
-					-- see zonkTcType, and zonkTcTypeToType
-         -> TcType
-	 -> TcM Type
+zonkType :: (TcTyVar -> TcM Type)  -- What to do with TcTyVars
+         -> TcType -> TcM Type
 zonkType zonk_tc_tyvar ty
   = go ty
   where
@@ -736,7 +725,7 @@ zonkType zonk_tc_tyvar ty
                                   ty2' <- go ty2
                                   return (EqPred ty1' ty2')
 
-mkZonkTcTyVar :: (TcTyVar -> TcM Type)	-- What to do for an unbound mutable var
+mkZonkTcTyVar :: (TcTyVar -> TcM Type)	-- What to do for an *mutable Flexi* var
  	      -> TcTyVar -> TcM TcType
 mkZonkTcTyVar unbound_var_fn tyvar 
   = ASSERT( isTcTyVar tyvar )