X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypes%2FType.lhs;h=3705914140e8d018224c7c8f5b82b387ca745eb4;hb=8897e76874e10daa4dc695342e68b15e114a6de0;hp=e2405a8644f264af58bff8abbb92216d15191be7;hpb=35fb5c6ff0861be5ab72df799df536982d3966b8;p=ghc-hetmet.git

diff --git a/compiler/types/Type.lhs b/compiler/types/Type.lhs
index e2405a8..3705914 100644
--- a/compiler/types/Type.lhs
+++ b/compiler/types/Type.lhs
@@ -41,7 +41,7 @@ module Type (
 	applyTy, applyTys, applyTysD, isForAllTy, dropForAlls,
 	
 	-- (Newtypes)
-	newTyConInstRhs,
+	newTyConInstRhs, carefullySplitNewType_maybe,
 	
 	-- (Type families)
         tyFamInsts, predFamInsts,
@@ -534,7 +534,7 @@ splitTyConApp_maybe (FunTy arg res)   = Just (funTyCon, [arg,res])
 splitTyConApp_maybe _                 = Nothing
 
 newTyConInstRhs :: TyCon -> [Type] -> Type
--- ^ Unwrap one 'layer' of newtype on a type constructor and it's arguments, using an 
+-- ^ Unwrap one 'layer' of newtype on a type constructor and its arguments, using an 
 -- eta-reduced version of the @newtype@ if possible
 newTyConInstRhs tycon tys 
     = ASSERT2( equalLength tvs tys1, ppr tycon $$ ppr tys $$ ppr tvs )
@@ -596,14 +596,9 @@ newtype at outermost level; and bale out if we see it again.
 -- | Looks through:
 --
 --	1. For-alls
---
 --	2. Synonyms
---
 --	3. Predicates
---
---	4. Usage annotations
---
---	5. All newtypes, including recursive ones, but not newtype families
+--	4. All newtypes, including recursive ones, but not newtype families
 --
 -- It's useful in the back end of the compiler.
 repType :: Type -> Type
@@ -618,19 +613,25 @@ repType ty
     go rec_nts (ForAllTy _ ty)			-- Look through foralls
 	= go rec_nts ty
 
-    go rec_nts ty@(TyConApp tc tys)		-- Expand newtypes
-	| Just _co_con <- newTyConCo_maybe tc	-- See Note [Expanding newtypes]
-	= if tc `elem` rec_nts 			--  in Type.lhs
-	  then ty
-	  else go rec_nts' nt_rhs
-	where
-	  nt_rhs = newTyConInstRhs tc tys
-	  rec_nts' | isRecursiveTyCon tc = tc:rec_nts
-		   | otherwise		 = rec_nts
+    go rec_nts (TyConApp tc tys)		-- Expand newtypes
+      | Just (rec_nts', ty') <- carefullySplitNewType_maybe rec_nts tc tys
+      = go rec_nts' ty'
 
     go _ ty = ty
 
 
+carefullySplitNewType_maybe :: [TyCon] -> TyCon -> [Type] -> Maybe ([TyCon],Type)
+-- Return the representation of a newtype, unless 
+-- we've seen it already: see Note [Expanding newtypes]
+carefullySplitNewType_maybe rec_nts tc tys
+  | isNewTyCon tc
+  , not (tc `elem` rec_nts)  = Just (rec_nts', newTyConInstRhs tc tys)
+  | otherwise	   	     = Nothing
+  where
+    rec_nts' | isRecursiveTyCon tc = tc:rec_nts
+	     | otherwise	   = rec_nts
+
+
 -- ToDo: this could be moved to the code generator, using splitTyConApp instead
 -- of inspecting the type directly.