Minor refactoring to get rid of Type.splitNewTyConApp

diff --git a/compiler/deSugar/DsUtils.lhs b/compiler/deSugar/DsUtils.lhs
index 62328bc..24579df 100644 (file)
--- a/compiler/deSugar/DsUtils.lhs
+++ b/compiler/deSugar/DsUtils.lhs
@@ -46,6 +46,7 @@ import {-# SOURCE #-} DsExpr( dsExpr )
 
 import HsSyn
 import TcHsSyn
+import TcType( tcSplitTyConApp )
 import CoreSyn
 import DsMonad
 
@@ -287,7 +288,8 @@ mkCoAlgCaseMatchResult var ty match_alts
     (con1, arg_ids1, match_result1) = ASSERT( notNull match_alts ) head match_alts
     arg_id1    = ASSERT( notNull arg_ids1 ) head arg_ids1
     var_ty      = idType var
-    (tc, ty_args) = splitNewTyConApp var_ty
+    (tc, ty_args) = tcSplitTyConApp var_ty     -- Don't look through newtypes
+                                               -- (not that splitTyConApp does, these days)
     newtype_rhs = unwrapNewTypeBody tc ty_args (Var var)
                
        -- Stuff for data types

diff --git a/compiler/ghci/RtClosureInspect.hs b/compiler/ghci/RtClosureInspect.hs
index a62e8ed..54b7b08 100644 (file)
--- a/compiler/ghci/RtClosureInspect.hs
+++ b/compiler/ghci/RtClosureInspect.hs
@@ -384,7 +384,7 @@ ppr_termM1 RefWrap{}     = panic "ppr_termM1 - RefWrap"
 ppr_termM1 NewtypeWrap{} = panic "ppr_termM1 - NewtypeWrap"
 
 pprNewtypeWrap y p NewtypeWrap{ty=ty, wrapped_term=t} 
-  | Just (tc,_) <- splitNewTyConApp_maybe ty
+  | Just (tc,_) <- tcSplitTyConApp_maybe ty
   , ASSERT(isNewTyCon tc) True
   , Just new_dc <- tyConSingleDataCon_maybe tc = do 
          real_term <- y max_prec t
@@ -679,7 +679,7 @@ cvObtainTerm hsc_env bound force mb_ty hval = runTR hsc_env $ do
                     let (t:tt) = unpointed in t : reOrderTerms pointed tt tys
   
   expandNewtypes t@Term{ ty=ty, subTerms=tt }
-   | Just (tc, args) <- splitNewTyConApp_maybe ty
+   | Just (tc, args) <- tcSplitTyConApp_maybe ty
    , isNewTyCon tc
    , wrapped_type    <- newTyConInstRhs tc args
    , Just dc         <- tyConSingleDataCon_maybe tc
@@ -827,8 +827,8 @@ congruenceNewtypes lhs rhs
          (l1',r1') <- congruenceNewtypes l1 r1
          return (mkFunTy l1' l2', mkFunTy r1' r2')
 -- TyconApp Inductive case; this is the interesting bit.
-    | Just (tycon_l, _) <- splitNewTyConApp_maybe lhs
-    , Just (tycon_r, _) <- splitNewTyConApp_maybe rhs 
+    | Just (tycon_l, _) <- tcSplitTyConApp_maybe lhs
+    , Just (tycon_r, _) <- tcSplitTyConApp_maybe rhs 
     , tycon_l /= tycon_r 
     = do rhs' <- upgrade tycon_l rhs
          return (lhs, rhs')

diff --git a/compiler/types/Type.lhs b/compiler/types/Type.lhs
index d80bd52..79a561a 100644 (file)
--- a/compiler/types/Type.lhs
+++ b/compiler/types/Type.lhs
@@ -36,7 +36,6 @@ module Type (
        mkTyConApp, mkTyConTy, 
        tyConAppTyCon, tyConAppArgs, 
        splitTyConApp_maybe, splitTyConApp, 
-        splitNewTyConApp_maybe, splitNewTyConApp,
 
         mkForAllTy, mkForAllTys, splitForAllTy_maybe, splitForAllTys, 
        applyTy, applyTys, applyTysD, isForAllTy, dropForAlls,
@@ -534,20 +533,6 @@ splitTyConApp_maybe (TyConApp tc tys) = Just (tc, tys)
 splitTyConApp_maybe (FunTy arg res)   = Just (funTyCon, [arg,res])
 splitTyConApp_maybe _                 = Nothing
 
--- | Sometimes we do NOT want to look through a @newtype@.  When case matching
--- on a newtype we want a convenient way to access the arguments of a @newtype@
--- constructor so as to properly form a coercion, and so we use 'splitNewTyConApp'
--- instead of 'splitTyConApp_maybe'
-splitNewTyConApp :: Type -> (TyCon, [Type])
-splitNewTyConApp ty = case splitNewTyConApp_maybe ty of
-                       Just stuff -> stuff
-                       Nothing    -> pprPanic "splitNewTyConApp" (ppr ty)
-splitNewTyConApp_maybe :: Type -> Maybe (TyCon, [Type])
-splitNewTyConApp_maybe ty | Just ty' <- tcView ty = splitNewTyConApp_maybe ty'
-splitNewTyConApp_maybe (TyConApp tc tys) = Just (tc, tys)
-splitNewTyConApp_maybe (FunTy arg res)   = Just (funTyCon, [arg,res])
-splitNewTyConApp_maybe _                 = Nothing
-
 newTyConInstRhs :: TyCon -> [Type] -> Type
 -- ^ Unwrap one 'layer' of newtype on a type constructor and it's arguments, using an 
 -- eta-reduced version of the @newtype@ if possible