X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcMType.lhs;h=b9db015e1dafc4ad612848a0aa4289e6e798f0b5;hb=4a305e63d409e00417ee68912b564ab7887d653b;hp=2edfdb0d9e28d598a19e2bce165a99c734c4afbb;hpb=847abda2eae30ef8f07870694765696ec16842a8;p=ghc-hetmet.git

diff --git a/compiler/typecheck/TcMType.lhs b/compiler/typecheck/TcMType.lhs
index 2edfdb0..b9db015 100644
--- a/compiler/typecheck/TcMType.lhs
+++ b/compiler/typecheck/TcMType.lhs
@@ -88,6 +88,7 @@ import ListSetOps
 import UniqSupply
 import SrcLoc
 import Outputable
+import FastString
 
 import Control.Monad	( when, unless )
 import Data.List	( (\\) )
@@ -222,7 +223,6 @@ checkTauTvUpdate orig_tv orig_ty
 	| isSynTyCon tc  = go_syn tc tys
 	| otherwise	 = do { tys' <- mapM go tys
                               ; return $ occurs (TyConApp tc) tys' }
-    go (NoteTy _ ty2) 	 = go ty2	-- Discard free-tyvar annotations
     go (PredTy p)	 = do { p' <- go_pred p
                               ; return $ occurs1 PredTy p' }
     go (FunTy arg res)   = do { arg' <- go arg
@@ -507,14 +507,12 @@ isFilledMetaTyVar tv
   | otherwise = return False
 
 writeMetaTyVar :: TcTyVar -> TcType -> TcM ()
-#ifndef DEBUG
-writeMetaTyVar tyvar ty = writeMutVar (metaTvRef tyvar) (Indirect ty)
-#else
+writeMetaTyVar tyvar ty
+  | not debugIsOn = writeMutVar (metaTvRef tyvar) (Indirect ty)
 writeMetaTyVar tyvar ty
   | not (isMetaTyVar tyvar)
   = pprTrace "writeMetaTyVar" (ppr tyvar) $
     return ()
-
   | otherwise
   = ASSERT( isMetaTyVar tyvar )
     -- TOM: It should also work for coercions
@@ -524,7 +522,6 @@ writeMetaTyVar tyvar ty
   where
     k1 = tyVarKind tyvar
     k2 = typeKind ty
-#endif
 \end{code}
 
 
@@ -888,8 +885,6 @@ zonkType :: (TcTyVar -> TcM Type) 	-- What to do with unbound mutable type varia
 zonkType unbound_var_fn ty
   = go ty
   where
-    go (NoteTy _ ty2) 	 = go ty2	-- Discard free-tyvar annotations
-
     go (TyConApp tc tys) = do tys' <- mapM go tys
                               return (TyConApp tc tys')
 
@@ -1112,9 +1107,6 @@ check_type rank ubx_tup (AppTy ty1 ty2)
   = do	{ check_arg_type rank ty1
 	; check_arg_type rank ty2 }
 
-check_type rank ubx_tup (NoteTy other_note ty)
-  = check_type rank ubx_tup ty
-
 check_type rank ubx_tup ty@(TyConApp tc tys)
   | isSynTyCon tc
   = do	{ 	-- Check that the synonym has enough args
@@ -1187,10 +1179,10 @@ check_arg_type rank ty
 	; checkTc (not (isUnLiftedType ty)) (unliftedArgErr ty) }
 
 ----------------------------------------
-forAllTyErr     ty = ptext SLIT("Illegal polymorphic or qualified type:") <+> ppr ty
-unliftedArgErr  ty = ptext SLIT("Illegal unlifted type:") <+> ppr ty
-ubxArgTyErr     ty = ptext SLIT("Illegal unboxed tuple type as function argument:") <+> ppr ty
-kindErr kind       = ptext SLIT("Expecting an ordinary type, but found a type of kind") <+> ppr kind
+forAllTyErr     ty = sep [ptext SLIT("Illegal polymorphic or qualified type:"), ppr ty]
+unliftedArgErr  ty = sep [ptext SLIT("Illegal unlifted type:"), ppr ty]
+ubxArgTyErr     ty = sep [ptext SLIT("Illegal unboxed tuple type as function argument:"), ppr ty]
+kindErr kind       = sep [ptext SLIT("Expecting an ordinary type, but found a type of kind"), ppr kind]
 \end{code}
 
 Note [Liberal type synonyms]
@@ -1754,7 +1746,6 @@ fvType :: Type -> [TyVar]
 fvType ty | Just exp_ty <- tcView ty = fvType exp_ty
 fvType (TyVarTy tv)        = [tv]
 fvType (TyConApp _ tys)    = fvTypes tys
-fvType (NoteTy _ ty)       = fvType ty
 fvType (PredTy pred)       = fvPred pred
 fvType (FunTy arg res)     = fvType arg ++ fvType res
 fvType (AppTy fun arg)     = fvType fun ++ fvType arg
@@ -1773,7 +1764,6 @@ sizeType :: Type -> Int
 sizeType ty | Just exp_ty <- tcView ty = sizeType exp_ty
 sizeType (TyVarTy _)       = 1
 sizeType (TyConApp _ tys)  = sizeTypes tys + 1
-sizeType (NoteTy _ ty)     = sizeType ty
 sizeType (PredTy pred)     = sizePred pred
 sizeType (FunTy arg res)   = sizeType arg + sizeType res + 1
 sizeType (AppTy fun arg)   = sizeType fun + sizeType arg