wibble

[ghc-hetmet.git] / compiler / ghci / RtClosureInspect.hs

diff --git a/compiler/ghci/RtClosureInspect.hs b/compiler/ghci/RtClosureInspect.hs
index d342337..6be0633 100644 (file)
--- a/compiler/ghci/RtClosureInspect.hs
+++ b/compiler/ghci/RtClosureInspect.hs
@@ -384,9 +384,9 @@ 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 <- maybeTyConSingleCon tc = do 
+  , Just new_dc <- tyConSingleDataCon_maybe tc = do 
          real_term <- y max_prec t
          return$ cparen (p >= app_prec) (ppr new_dc <+> real_term)
 pprNewtypeWrap _ _ _ = panic "pprNewtypeWrap"
@@ -445,7 +445,7 @@ cPprTermBase y =
 
            isTupleTy ty    = fromMaybe False $ do 
              (tc,_) <- splitTyConApp_maybe ty 
-             return (tc `elem` (fst.unzip.elems) boxedTupleArr)
+             return (isBoxedTupleTyCon tc)
 
            isTyCon a_tc ty = fromMaybe False $ do 
              (tc,_) <- splitTyConApp_maybe ty
@@ -646,7 +646,7 @@ cvObtainTerm hsc_env bound force mb_ty hval = runTR hsc_env $ do
                   (signatureType,_) <- instScheme(dataConRepType dc) 
                   addConstraint myType signatureType
             subTermsP <- sequence $ drop extra_args 
-                                 -- ^^^  all extra arguments are pointed
+                                -- \^^^  all extra arguments are pointed
                   [ appArr (go (pred bound) tv t) (ptrs clos) i
                    | (i,tv,t) <- zip3 [0..] subTermTvs subTtypesP]
             let unboxeds   = extractUnboxed subTtypesNP clos
@@ -679,10 +679,10 @@ 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         <- maybeTyConSingleCon tc
+   , Just dc         <- tyConSingleDataCon_maybe tc
    , t'              <- expandNewtypes t{ ty = wrapped_type
                                         , subTerms = map expandNewtypes tt }
    = NewtypeWrap ty (Right dc) t'
@@ -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')
@@ -891,6 +891,6 @@ zonkTerm = foldTerm idTermFoldM {
 -- Is this defined elsewhere?
 -- Generalize the type: find all free tyvars and wrap in the appropiate ForAll.
 sigmaType :: Type -> Type
-sigmaType ty = mkForAllTys (varSetElems$ tyVarsOfType (dropForAlls ty)) ty
+sigmaType ty = mkSigmaTy (varSetElems$ tyVarsOfType (dropForAlls ty)) [] ty