Tidy up the treatment of newtypes, refactor, and fix Trac #736

I've forgotten the precise details already, but this patch
significantly refactors the way newtypes are handled, fixes
the foreign-export problem Trac #736 (which concerned newtypes),
and gets rid of a bogus unsafeCoerce in the foreign export
desugaring.

compiler/basicTypes/DataCon.lhs

@@ -766,8 +766,9 @@ splitProductType str ty
 deepSplitProductType_maybe ty
   = do { (res@(tycon, tycon_args, _, _)) <- splitProductType_maybe ty
        ; let {result 
-             | isClosedNewTyCon tycon && not (isRecursiveTyCon tycon)
-             = deepSplitProductType_maybe (newTyConInstRhs tycon tycon_args)
+             | Just (ty', _co) <- instNewTyCon_maybe tycon tycon_args
+	     , not (isRecursiveTyCon tycon)
+             = deepSplitProductType_maybe ty'	-- Ignore the coercion?
              | isNewTyCon tycon = Nothing  -- cannot unbox through recursive
 					   -- newtypes nor through families
              | otherwise = Just res}

compiler/coreSyn/CoreUtils.lhs

@@ -8,7 +8,7 @@ Utility functions on @Core@ syntax
 \begin{code}
 module CoreUtils (
 	-- Construction
-	mkInlineMe, mkSCC, mkCoerce, 
+	mkInlineMe, mkSCC, mkCoerce, mkCoerceI,
 	bindNonRec, needsCaseBinding,
 	mkIfThenElse, mkAltExpr, mkPiType, mkPiTypes,
 
@@ -194,6 +194,10 @@ mkInlineMe e	   = Note InlineMe e
 
 
 \begin{code}
+mkCoerceI :: CoercionI -> CoreExpr -> CoreExpr
+mkCoerceI IdCo e = e
+mkCoerceI (ACo co) e = mkCoerce co e
+
 mkCoerce :: Coercion -> CoreExpr -> CoreExpr
 mkCoerce co (Cast expr co2)
   = ASSERT(let { (from_ty, _to_ty) = coercionKind co; 
@@ -1159,8 +1163,8 @@ eta_expand n us expr ty
 		--	coerce T (\x::[T] -> (coerce ([T]->Int) e) x)
 
     	case splitNewTypeRepCo_maybe ty of {
- 	  Just(ty1,co) -> 
-              mkCoerce (mkSymCoercion co) (eta_expand n us (mkCoerce co expr) ty1) ;
+ 	  Just(ty1,co) -> mkCoerce (mkSymCoercion co) 
+				   (eta_expand n us (mkCoerce co expr) ty1) ;
  	  Nothing  -> 
 
 	-- We have an expression of arity > 0, but its type isn't a function

compiler/deSugar/DsCCall.lhs

@@ -91,9 +91,9 @@ dsCCall :: CLabelString	-- C routine to invoke
 	-> DsM CoreExpr	-- Result, of type ???
 
 dsCCall lbl args may_gc result_ty
-  = mapAndUnzipDs unboxArg args	       `thenDs` \ (unboxed_args, arg_wrappers) ->
+  = mapAndUnzipDs unboxArg args	    `thenDs` \ (unboxed_args, arg_wrappers) ->
     boxResult id Nothing result_ty  `thenDs` \ (ccall_result_ty, res_wrapper) ->
-    newUnique			       `thenDs` \ uniq ->
+    newUnique			    `thenDs` \ uniq ->
     let
 	target = StaticTarget lbl
 	the_fcall    = CCall (CCallSpec target CCallConv may_gc)
@@ -182,6 +182,7 @@ unboxArg arg
 
     )
 
+  ----- Cases for .NET; almost certainly bit-rotted ---------
   | Just (tc, [arg_ty]) <- splitTyConApp_maybe arg_ty,
     tc == listTyCon,
     Just (cc,[]) <- splitTyConApp_maybe arg_ty,
@@ -193,7 +194,7 @@ unboxArg arg
     	      \ body ->
 	        let
 		 io_ty = exprType body
-		 Just (_,io_arg) = tcSplitIOType_maybe io_ty
+		 Just (_,io_arg,_) = tcSplitIOType_maybe io_ty
 		in
 	      	mkApps (Var unpack_id)
 		       [ Type io_arg
@@ -209,13 +210,14 @@ unboxArg arg
     	      \ body ->
 	        let
 		 io_ty = exprType body
-		 Just (_,io_arg) = tcSplitIOType_maybe io_ty
+		 Just (_,io_arg,_) = tcSplitIOType_maybe io_ty
 		in
 	      	mkApps (Var unpack_id)
 		       [ Type io_arg
 		       , arg
 		       , Lam prim_obj body
 		       ])
+  --------------- End of cases for .NET --------------------
 
   | otherwise
   = getSrcSpanDs `thenDs` \ l ->
@@ -235,7 +237,8 @@ unboxArg arg
 
 
 \begin{code}
-boxResult :: ((Maybe Type, CoreExpr -> CoreExpr) -> (Maybe Type, CoreExpr -> CoreExpr))
+boxResult :: ((Maybe Type, CoreExpr -> CoreExpr)
+		 -> (Maybe Type, CoreExpr -> CoreExpr))
 	  -> Maybe Id
 	  -> Type
 	  -> DsM (Type, CoreExpr -> CoreExpr)
@@ -255,45 +258,45 @@ boxResult :: ((Maybe Type, CoreExpr -> CoreExpr) -> (Maybe Type, CoreExpr -> Cor
 -- It looks a mess: I wonder if it could be refactored.
 
 boxResult augment mbTopCon result_ty
-  | Just (io_tycon, io_res_ty) <- tcSplitIOType_maybe result_ty
+  | Just (io_tycon, io_res_ty, co) <- tcSplitIOType_maybe result_ty
 	-- isIOType_maybe handles the case where the type is a 
 	-- simple wrapping of IO.  E.g.
 	-- 	newtype Wrap a = W (IO a)
-	-- No coercion necessay because its a non-recursive newtype
+	-- No coercion necessary because its a non-recursive newtype
 	-- (If we wanted to handle a *recursive* newtype too, we'd need
 	-- another case, and a coercion.)
-  = 	-- The result is IO t, so wrap the result in an IO constructor
-	
-    resultWrapper io_res_ty             `thenDs` \ res ->
-    let aug_res          = augment res
-        extra_result_tys = case aug_res of
-			     (Just ty,_) 
-			       | isUnboxedTupleType ty 
-			       -> let (Just (_, ls)) = splitTyConApp_maybe ty in tail ls
-			     _ -> []
-
-        return_result state anss
-	  = mkConApp (tupleCon Unboxed (2 + length extra_result_tys))
-	             (map Type (realWorldStatePrimTy : io_res_ty : extra_result_tys)
-		      ++ (state : anss)) 
-    in
-    mk_alt return_result aug_res 	`thenDs` \ (ccall_res_ty, the_alt) ->
-    newSysLocalDs realWorldStatePrimTy	`thenDs` \ state_id ->
-    let
-	io_data_con = head (tyConDataCons io_tycon)
-	toIOCon = case mbTopCon of
-			Nothing -> dataConWrapId io_data_con
-			Just x  -> x
-	wrap = \ the_call -> mkApps (Var toIOCon)
-				    [ Type io_res_ty, 
-				      Lam state_id $
-				       Case (App the_call (Var state_id))
-				    	   (mkWildId ccall_res_ty)
-                                            (coreAltType the_alt) 
-				    	   [the_alt]
-				    ]
-    in
-    returnDs (realWorldStatePrimTy `mkFunTy` ccall_res_ty, wrap)
+   	-- The result is IO t, so wrap the result in an IO constructor
+  = do	{ res <- resultWrapper io_res_ty
+	; let aug_res = augment res
+	      extra_result_tys 
+		= case aug_res of
+		     (Just ty,_) 
+		       | isUnboxedTupleType ty 
+		       -> let (Just (_, ls)) = splitTyConApp_maybe ty in tail ls
+		     _ -> []
+
+	      return_result state anss
+		= mkConApp (tupleCon Unboxed (2 + length extra_result_tys))
+	         	   (map Type (realWorldStatePrimTy : io_res_ty : extra_result_tys)
+			      ++ (state : anss)) 
+
+	; (ccall_res_ty, the_alt) <- mk_alt return_result aug_res
+
+	; state_id <- newSysLocalDs realWorldStatePrimTy
+	; let io_data_con = head (tyConDataCons io_tycon)
+	      toIOCon     = mbTopCon `orElse` dataConWrapId io_data_con
+
+	      wrap the_call = mkCoerceI (mkSymCoI co) $
+			      mkApps (Var toIOCon)
+			    	     [ Type io_res_ty, 
+			    	       Lam state_id $
+			    	       Case (App the_call (Var state_id))
+			    	     	     (mkWildId ccall_res_ty)
+			                     (coreAltType the_alt) 
+			    	     	     [the_alt]
+			    	     ]
+
+	; return (realWorldStatePrimTy `mkFunTy` ccall_res_ty, wrap) }
 
 boxResult augment mbTopCon result_ty
   = 	-- It isn't IO, so do unsafePerformIO
@@ -302,9 +305,9 @@ boxResult augment mbTopCon result_ty
     mk_alt return_result (augment res) `thenDs` \ (ccall_res_ty, the_alt) ->
     let
 	wrap = \ the_call -> Case (App the_call (Var realWorldPrimId)) 
-					      (mkWildId ccall_res_ty)
-                                              (coreAltType the_alt)
-					      [the_alt]
+			    	  (mkWildId ccall_res_ty)
+			          (coreAltType the_alt)
+			    	  [the_alt]
     in
     returnDs (realWorldStatePrimTy `mkFunTy` ccall_res_ty, wrap)
   where
@@ -360,6 +363,9 @@ mk_alt return_result (Just prim_res_ty, wrap_result)
 resultWrapper :: Type
    	      -> DsM (Maybe Type,		-- Type of the expected result, if any
 		      CoreExpr -> CoreExpr)	-- Wrapper for the result 
+-- resultWrapper deals with the result *value*
+-- E.g. foreign import foo :: Int -> IO T
+-- Then resultWrapper deals with marshalling the 'T' part
 resultWrapper result_ty
   -- Base case 1: primitive types
   | isPrimitiveType result_ty

compiler/deSugar/DsForeign.lhs

@@ -282,8 +282,9 @@ dsFExport fn_id ty ext_name cconv isDyn
 	-- If it's IO t, return		(t, True)
 	-- If it's plain t, return	(t, False)
      (case tcSplitIOType_maybe orig_res_ty of
-	Just (ioTyCon, res_ty) -> returnDs (res_ty, True)
+	Just (ioTyCon, res_ty, co) -> returnDs (res_ty, True)
 		-- The function already returns IO t
+		-- ToDo: what about the coercion?
 	Nothing 	       -> returnDs (orig_res_ty, False)	
 		-- The function returns t
      )					`thenDs` \ (res_ty,		-- t
@@ -339,7 +340,6 @@ dsFExportDynamic id cconv
      dsLookupGlobalId newStablePtrName		`thenDs` \ newStablePtrId ->
      dsLookupTyCon stablePtrTyConName		`thenDs` \ stable_ptr_tycon ->
      let
-	mk_stbl_ptr_app = mkApps (Var newStablePtrId) [ Type arg_ty, Var cback ]
 	stable_ptr_ty	= mkTyConApp stable_ptr_tycon [arg_ty]
 	export_ty	= mkFunTy stable_ptr_ty arg_ty
      in
@@ -348,12 +348,6 @@ dsFExportDynamic id cconv
      dsFExport id export_ty fe_nm cconv True  	
 		`thenDs` \ (h_code, c_code, arg_reps, args_size) ->
      let
-      stbl_app cont ret_ty = mkApps (Var bindIOId)
-				    [ Type stable_ptr_ty
-				    , Type ret_ty       
-				    , mk_stbl_ptr_app
-				    , cont
-				    ]
        {-
         The arguments to the external function which will
 	create a little bit of (template) code on the fly
@@ -384,18 +378,19 @@ dsFExportDynamic id cconv
 		      _ 	  -> Nothing
 
      in
-     dsCCall adjustor adj_args PlayRisky io_res_ty	`thenDs` \ ccall_adj ->
+     dsCCall adjustor adj_args PlayRisky (mkTyConApp io_tc [res_ty])  `thenDs` \ ccall_adj ->
 	-- PlayRisky: the adjustor doesn't allocate in the Haskell heap or do a callback
-     let ccall_adj_ty = exprType ccall_adj
-         ccall_io_adj = mkLams [stbl_value]		     $
-#ifdef DEBUG
-			pprTrace "DsForeign: why is there an unsafeCoerce here?" (text "") $
-#endif
-			(Cast ccall_adj (mkUnsafeCoercion ccall_adj_ty io_res_ty ))
 
-         io_app = mkLams tvs	 $
-		  mkLams [cback] $
-		  stbl_app ccall_io_adj res_ty
+     let io_app = mkLams tvs	 	    $
+		  Lam cback	 	    $          
+		  mkCoerceI (mkSymCoI co)   $
+		  mkApps (Var bindIOId)
+			 [ Type stable_ptr_ty
+			 , Type res_ty       
+			 , mkApps (Var newStablePtrId) [ Type arg_ty, Var cback ]
+			 , Lam stbl_value ccall_adj
+			 ]
+
 	 fed = (id `setInlinePragma` NeverActive, io_app)
 		-- Never inline the f.e.d. function, because the litlit
 		-- might not be in scope in other modules.
@@ -403,11 +398,12 @@ dsFExportDynamic id cconv
      returnDs ([fed], h_code, c_code)
 
  where
-  ty			= idType id
-  (tvs,sans_foralls)	= tcSplitForAllTys ty
-  ([arg_ty], io_res_ty)	= tcSplitFunTys sans_foralls
-  [res_ty]		= tcTyConAppArgs io_res_ty
-	-- Must use tcSplit* to see the (IO t), which is a newtype
+  ty			   = idType id
+  (tvs,sans_foralls)	   = tcSplitForAllTys ty
+  ([arg_ty], fn_res_ty)	   = tcSplitFunTys sans_foralls
+  Just (io_tc, res_ty, co) = tcSplitIOType_maybe fn_res_ty
+	-- Must have an IO type; hence Just
+	-- co : fn_res_ty ~ IO res_ty
 
 toCName :: Id -> String
 toCName i = showSDoc (pprCode CStyle (ppr (idName i)))

compiler/typecheck/TcForeign.lhs

@@ -263,7 +263,7 @@ mustBeIO = False
 
 checkForeignRes non_io_result_ok pred_res_ty ty
 	-- (IO t) is ok, and so is any newtype wrapping thereof
-  | Just (io, res_ty) <- tcSplitIOType_maybe ty,
+  | Just (io, res_ty, _) <- tcSplitIOType_maybe ty,
     pred_res_ty res_ty
   = returnM ()
  

compiler/typecheck/TcType.lhs

@@ -140,6 +140,7 @@ import ForeignCall
 import Unify
 import VarSet
 import Type
+import Coercion
 import TyCon
 
 -- others:
@@ -840,6 +841,7 @@ tcSplitPredTy_maybe other	  = Nothing
 predTyUnique :: PredType -> Unique
 predTyUnique (IParam n _)      = getUnique (ipNameName n)
 predTyUnique (ClassP clas tys) = getUnique clas
+predTyUnique (EqPred a b)      = pprPanic "predTyUnique" (ppr (EqPred a b))
 \end{code}
 
 
@@ -1050,6 +1052,7 @@ exactTyVarsOfType ty
     go (AppTy fun arg)	    	  = go fun `unionVarSet` go arg
     go (ForAllTy tyvar ty)  	  = delVarSet (go ty) tyvar
                                     `unionVarSet` go_tv tyvar
+    go (NoteTy _ _) 		  = panic "exactTyVarsOfType"	-- Handled by tcView
 
     go_pred (IParam _ ty)    = go ty
     go_pred (ClassP _ tys)   = exactTyVarsOfTypes tys
@@ -1103,22 +1106,28 @@ restricted set of types as arguments and results (the restricting factor
 being the )
 
 \begin{code}
-tcSplitIOType_maybe :: Type -> Maybe (TyCon, Type)
--- (isIOType t) returns (Just (IO,t')) if t is of the form (IO t'), or
---				       some newtype wrapping thereof
+tcSplitIOType_maybe :: Type -> Maybe (TyCon, Type, CoercionI)
+-- (isIOType t) returns Just (IO,t',co)
+--				if co : t ~ IO t'
 --		returns Nothing otherwise
 tcSplitIOType_maybe ty 
-  | Just (io_tycon, [io_res_ty]) <- tcSplitTyConApp_maybe ty,
+  = case tcSplitTyConApp_maybe ty of
 	-- This split absolutely has to be a tcSplit, because we must
 	-- see the IO type; and it's a newtype which is transparent to splitTyConApp.
-    io_tycon `hasKey` ioTyConKey
-  = Just (io_tycon, io_res_ty)
 
-  | Just ty' <- coreView ty	-- Look through non-recursive newtypes
-  = tcSplitIOType_maybe ty'
+	Just (io_tycon, [io_res_ty]) 
+	   |  io_tycon `hasKey` ioTyConKey 
+	   -> Just (io_tycon, io_res_ty, IdCo)
 
-  | otherwise
-  = Nothing
+	Just (tc, tys)
+	   | not (isRecursiveTyCon tc)
+	   , Just (ty, co1) <- instNewTyCon_maybe tc tys
+		  -- Newtypes that require a coercion are ok
+	   -> case tcSplitIOType_maybe ty of
+		Nothing		    -> Nothing
+		Just (tc, ty', co2) -> Just (tc, ty', co1 `mkTransCoI` co2)
+
+	other -> Nothing
 
 isFFITy :: Type -> Bool
 -- True for any TyCon that can possibly be an arg or result of an FFI call

compiler/types/Coercion.lhs

@@ -27,7 +27,7 @@ module Coercion (
         mkForAllCoercion, mkFunCoercion, mkInstsCoercion, mkUnsafeCoercion,
         mkNewTypeCoercion, mkFamInstCoercion, mkAppsCoercion,
 
-        splitNewTypeRepCo_maybe, decomposeCo,
+        splitNewTypeRepCo_maybe, instNewTyCon_maybe, decomposeCo,
 
         unsafeCoercionTyCon, symCoercionTyCon,
         transCoercionTyCon, leftCoercionTyCon, 
@@ -413,24 +413,37 @@ unsafeCoercionTyConName = mkCoConName FSLIT("CoUnsafe") unsafeCoercionTyConKey u
 
 
 
+instNewTyCon_maybe :: TyCon -> [Type] -> Maybe (Type, CoercionI)
+-- instNewTyCon_maybe T ts
+--	= Just (rep_ty, co)	if   co : T ts ~ rep_ty
+instNewTyCon_maybe tc tys
+  | Just (tvs, ty, mb_co_tc) <- unwrapNewTyCon_maybe tc
+  = ASSERT( tys `lengthIs` tyConArity tc )
+    Just (substTyWith tvs tys ty, 
+	  case mb_co_tc of
+	   Nothing    -> IdCo
+	   Just co_tc -> ACo (mkTyConApp co_tc tys))
+  | otherwise
+  = Nothing
+
 -- this is here to avoid module loops
 splitNewTypeRepCo_maybe :: Type -> Maybe (Type, Coercion)  
 -- Sometimes we want to look through a newtype and get its associated coercion
 -- It only strips *one layer* off, so the caller will usually call itself recursively
 -- Only applied to types of kind *, hence the newtype is always saturated
+--    splitNewTypeRepCo_maybe ty
+--	= Just (ty', co)  if   co : ty ~ ty'
+-- Returns Nothing for non-newtypes or fully-transparent newtypes
 splitNewTypeRepCo_maybe ty 
   | Just ty' <- coreView ty = splitNewTypeRepCo_maybe ty'
 splitNewTypeRepCo_maybe (TyConApp tc tys)
-  | isClosedNewTyCon tc 
-  = ASSERT( tys `lengthIs` tyConArity tc )	-- splitNewTypeRepCo_maybe only be applied 
-                                                -- 	to *types* (of kind *)
-        case newTyConRhs tc of
-	  (tvs, rep_ty) -> 
-              ASSERT( length tvs == length tys )
-	      Just (substTyWith tvs tys rep_ty, mkTyConApp co_con tys)
-  where
-    co_con = maybe (pprPanic "splitNewTypeRepCo_maybe" (ppr tc)) id (newTyConCo_maybe tc)
-splitNewTypeRepCo_maybe other = Nothing
+  | Just (ty', coi) <- instNewTyCon_maybe tc tys
+  = case coi of
+	ACo co -> Just (ty', co)
+	IdCo   -> panic "splitNewTypeRepCo_maybe"
+			-- This case handled by coreView
+splitNewTypeRepCo_maybe other 
+  = Nothing
 \end{code}
 
 
@@ -440,7 +453,6 @@ splitNewTypeRepCo_maybe other = Nothing
 
 
 \begin{code}
-
 	-- CoercionI is either 
 	--	(a) proper coercion
 	--	(b) the identity coercion

compiler/types/TyCon.lhs

@@ -18,8 +18,10 @@ module TyCon(
 	SynTyConRhs(..),
 
 	isFunTyCon, isUnLiftedTyCon, isProductTyCon, 
-	isAlgTyCon, isDataTyCon, isNewTyCon, isClosedNewTyCon, isSynTyCon,
-	isClosedSynTyCon, isPrimTyCon, 
+	isAlgTyCon, isDataTyCon, 
+	isNewTyCon, unwrapNewTyCon_maybe, 
+	isSynTyCon, isClosedSynTyCon, 
+	isPrimTyCon, 
 	isEnumerationTyCon, isGadtSyntaxTyCon, isOpenTyCon,
 	assocTyConArgPoss_maybe, isTyConAssoc, setTyConArgPoss,
 	isTupleTyCon, isUnboxedTupleTyCon, isBoxedTupleTyCon, tupleTyConBoxity,
@@ -642,19 +644,15 @@ isDataTyCon (TupleTyCon {tyConBoxed = boxity}) = isBoxed boxity
 isDataTyCon other = False
 
 isNewTyCon :: TyCon -> Bool
-isNewTyCon (AlgTyCon {algTcRhs = rhs}) = 
-  case rhs of
-    NewTyCon {}  -> True
-    _	         -> False
-isNewTyCon other		       = False
-
--- This is an important refinement as typical newtype optimisations do *not*
--- hold for newtype families.  Why?  Given a type `T a', if T is a newtype
--- family, there is no unique right hand side by which `T a' can be replaced
--- by a cast.
---
-isClosedNewTyCon :: TyCon -> Bool
-isClosedNewTyCon tycon = isNewTyCon tycon && not (isOpenTyCon tycon)
+isNewTyCon (AlgTyCon {algTcRhs = NewTyCon {}}) = True
+isNewTyCon other		               = False
+
+unwrapNewTyCon_maybe :: TyCon -> Maybe ([TyVar], Type, Maybe TyCon)
+unwrapNewTyCon_maybe (AlgTyCon { tyConTyVars = tvs, 
+				 algTcRhs = NewTyCon { nt_co = mb_co, 
+						       nt_rhs = rhs }})
+			   = Just (tvs, rhs, mb_co)
+unwrapNewTyCon_maybe other = Nothing
 
 isProductTyCon :: TyCon -> Bool
 -- A "product" tycon

compiler/types/Type.lhs

@@ -407,8 +407,6 @@ splitNewTyConApp_maybe (TyConApp tc tys) = Just (tc, tys)
 splitNewTyConApp_maybe (FunTy arg res)   = Just (funTyCon, [arg,res])
 splitNewTyConApp_maybe other	      = Nothing
 
--- get instantiated newtype rhs, the arguments had better saturate 
--- the constructor
 newTyConInstRhs :: TyCon -> [Type] -> Type
 newTyConInstRhs tycon tys =
     let (tvs, ty) = newTyConRhs tycon in substTyWith tvs tys ty
@@ -450,12 +448,15 @@ repType :: Type -> Type
 repType ty | Just ty' <- coreView ty = repType ty'
 repType (ForAllTy _ ty)  = repType ty
 repType (TyConApp tc tys)
-  | isClosedNewTyCon tc  = -- Recursive newtypes are opaque to coreView
-			   -- but we must expand them here.  Sure to
-			   -- be saturated because repType is only applied
-			   -- to types of kind *
-			   ASSERT( {- isRecursiveTyCon tc && -} tys `lengthIs` tyConArity tc )
-			   repType (new_type_rep tc tys)
+  | isNewTyCon tc
+  , (tvs, rep_ty) <- newTyConRep tc
+  = -- Recursive newtypes are opaque to coreView
+    -- but we must expand them here.  Sure to
+    -- be saturated because repType is only applied
+    -- to types of kind *
+    ASSERT( tys `lengthIs` tyConArity tc )
+    repType (substTyWith tvs tys rep_ty)
+
 repType ty = ty
 
 -- repType' aims to be a more thorough version of repType
@@ -468,12 +469,6 @@ repType' ty -- | pprTrace "repType'" (ppr ty $$ ppr (go1 ty)) False = undefined
         go ty = ty
 
 
--- new_type_rep doesn't ask any questions: 
--- it just expands newtype, whether recursive or not
-new_type_rep new_tycon tys = ASSERT( tys `lengthIs` tyConArity new_tycon )
-			     case newTyConRep new_tycon of
-				 (tvs, rep_ty) -> substTyWith tvs tys rep_ty
-
 -- ToDo: this could be moved to the code generator, using splitTyConApp instead
 -- of inspecting the type directly.
 typePrimRep :: Type -> PrimRep
@@ -488,7 +483,6 @@ typePrimRep ty = case repType ty of
 	-- The reason is that f must have kind *->*, not *->*#, because
 	-- (we claim) there is no way to constrain f's kind any other
 	-- way.
-
 \end{code}