From 299c3d09f5d97c034ce0675d04cc65b9860eb73a Mon Sep 17 00:00:00 2001
From: "simonpj@microsoft.com" <unknown>
Date: Wed, 10 Sep 2008 15:42:00 +0000
Subject: [PATCH] Remove dataConInstOrigDictsAndArgTys

This suspicious function had just one call, in BuildTyCl.mkNewTyConRhs.
I've done it another way now, which is tidier.
---
 compiler/basicTypes/DataCon.lhs |   24 +++---------------------
 compiler/iface/BuildTyCl.lhs    |   13 ++++++++-----
 2 files changed, 11 insertions(+), 26 deletions(-)

diff --git a/compiler/basicTypes/DataCon.lhs b/compiler/basicTypes/DataCon.lhs
index a01cf74..e7ffb58 100644
--- a/compiler/basicTypes/DataCon.lhs
+++ b/compiler/basicTypes/DataCon.lhs
@@ -19,8 +19,7 @@ module DataCon (
 	dataConUnivTyVars, dataConExTyVars, dataConAllTyVars, 
 	dataConEqSpec, eqSpecPreds, dataConEqTheta, dataConDictTheta, dataConStupidTheta, 
 	dataConInstArgTys, dataConOrigArgTys, dataConOrigResTy,
-	dataConInstOrigArgTys, dataConInstOrigDictsAndArgTys,
-	dataConRepArgTys, 
+	dataConInstOrigArgTys, dataConRepArgTys, 
 	dataConFieldLabels, dataConFieldType,
 	dataConStrictMarks, dataConExStricts,
 	dataConSourceArity, dataConRepArity,
@@ -761,8 +760,8 @@ dataConInstArgTys dc@(MkData {dcRepArgTys = rep_arg_tys,
    ASSERT2 ( null ex_tvs && null eq_spec, ppr dc )        
    map (substTyWith univ_tvs inst_tys) rep_arg_tys
 
--- | Returns just the instantiated /value/ arguments of a 'DataCon',
--- as opposed to including the dictionary args as in 'dataConInstOrigDictsAndArgTys'
+-- | Returns just the instantiated /value/ argument types of a 'DataCon',
+-- (excluding dictionary args)
 dataConInstOrigArgTys 
 	:: DataCon	-- Works for any DataCon
 	-> [Type]	-- Includes existential tyvar args, but NOT
@@ -778,23 +777,6 @@ dataConInstOrigArgTys dc@(MkData {dcOrigArgTys = arg_tys,
     map (substTyWith tyvars inst_tys) arg_tys
   where
     tyvars = univ_tvs ++ ex_tvs
-
--- | Returns just the instantiated dicts and /value/ arguments for a 'DataCon',
--- as opposed to excluding the dictionary args as in 'dataConInstOrigArgTys'
-dataConInstOrigDictsAndArgTys 
-	:: DataCon	-- Works for any DataCon
-	-> [Type]	-- Includes existential tyvar args, but NOT
-			-- equality constraints or dicts
-	-> [Type]
-dataConInstOrigDictsAndArgTys dc@(MkData {dcOrigArgTys = arg_tys,
-				  dcDictTheta = dicts,       
-			          dcUnivTyVars = univ_tvs, 
-			          dcExTyVars = ex_tvs}) inst_tys
-  = ASSERT2( length tyvars == length inst_tys
-          , ptext (sLit "dataConInstOrigDictsAndArgTys") <+> ppr dc $$ ppr tyvars $$ ppr inst_tys )
-    map (substTyWith tyvars inst_tys) (mkPredTys dicts ++ arg_tys)
-  where
-    tyvars = univ_tvs ++ ex_tvs
 \end{code}
 
 \begin{code}
diff --git a/compiler/iface/BuildTyCl.lhs b/compiler/iface/BuildTyCl.lhs
index ef75d7f..296b430 100644
--- a/compiler/iface/BuildTyCl.lhs
+++ b/compiler/iface/BuildTyCl.lhs
@@ -148,13 +148,16 @@ mkNewTyConRhs tycon_name tycon con
         -- non-recursive newtypes
     all_coercions = True
     tvs    = tyConTyVars tycon
-    rhs_ty = ASSERT(not (null (dataConInstOrigDictsAndArgTys con (mkTyVarTys tvs)))) 
-	     -- head (dataConInstOrigArgTys con (mkTyVarTys tvs))
-	     head (dataConInstOrigDictsAndArgTys con (mkTyVarTys tvs))
+    inst_con_ty = applyTys (dataConUserType con) (mkTyVarTys tvs)
+    rhs_ty = ASSERT( isFunTy inst_con_ty ) funArgTy inst_con_ty
 	-- Instantiate the data con with the 
 	-- type variables from the tycon
-	-- NB: a newtype DataCon has no existentials; hence the
-	--     call to dataConInstOrigArgTys has the right type args
+	-- NB: a newtype DataCon has a type that must look like
+	--        forall tvs.  <arg-ty> -> T tvs
+	-- Note that we *can't* use dataConInstOrigArgTys here because
+	-- the newtype arising from   class Foo a => Bar a where {}
+  	-- has a single argument (Foo a) that is a *type class*, so
+	-- dataConInstOrigArgTys returns [].
 
     etad_tvs :: [TyVar]	-- Matched lazily, so that mkNewTypeCoercion can
     etad_rhs :: Type	-- return a TyCon without pulling on rhs_ty
-- 
1.7.10.4