Remove dataConInstOrigDictsAndArgTys

This suspicious function had just one call, in BuildTyCl.mkNewTyConRhs.
I've done it another way now, which is tidier.

diff --git a/compiler/basicTypes/DataCon.lhs b/compiler/basicTypes/DataCon.lhs
index a01cf74..e7ffb58 100644 (file)
--- 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 (file)
--- 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