X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fghci%2FRtClosureInspect.hs;h=a62e8ed59c6d7278a5b9a02306ef763f72b5cc7d;hb=ae6bd0bc7488bd26e93f8f9cbe3d04ed2d96d1b6;hp=3702ec4b3b384c805947cde85f644f9754a44008;hpb=e314b86f6290e5440a46cd5cc29f7878cb78c6fb;p=ghc-hetmet.git

diff --git a/compiler/ghci/RtClosureInspect.hs b/compiler/ghci/RtClosureInspect.hs
index 3702ec4..a62e8ed 100644
--- a/compiler/ghci/RtClosureInspect.hs
+++ b/compiler/ghci/RtClosureInspect.hs
@@ -70,9 +70,7 @@ import Outputable
 import FastString
 import Panic
 
-#ifndef GHCI_TABLES_NEXT_TO_CODE
 import Constants        ( wORD_SIZE )
-#endif
 
 import GHC.Arr          ( Array(..) )
 import GHC.Exts
@@ -180,15 +178,17 @@ getClosureData :: a -> IO Closure
 getClosureData a =
    case unpackClosure# a of 
      (# iptr, ptrs, nptrs #) -> do
-#ifndef GHCI_TABLES_NEXT_TO_CODE
-           -- the info pointer we get back from unpackClosure# is to the
-           -- beginning of the standard info table, but the Storable instance
-           -- for info tables takes into account the extra entry pointer
-           -- when !tablesNextToCode, so we must adjust here:
-           itbl <- peek (Ptr iptr `plusPtr` negate wORD_SIZE)
-#else
-           itbl <- peek (Ptr iptr)
-#endif
+           let iptr'
+                | ghciTablesNextToCode =
+                   Ptr iptr
+                | otherwise =
+                   -- the info pointer we get back from unpackClosure#
+                   -- is to the beginning of the standard info table,
+                   -- but the Storable instance for info tables takes
+                   -- into account the extra entry pointer when
+                   -- !ghciTablesNextToCode, so we must adjust here:
+                   Ptr iptr `plusPtr` negate wORD_SIZE
+           itbl <- peek iptr'
            let tipe = readCType (BCI.tipe itbl)
                elems = fromIntegral (BCI.ptrs itbl)
                ptrsList = Array 0 (elems - 1) elems ptrs
@@ -377,7 +377,7 @@ ppr_termM1 Prim{value=words, ty=ty} =
     return$ text$ repPrim (tyConAppTyCon ty) words
 ppr_termM1 Suspension{bound_to=Nothing} = return$ char '_'
 ppr_termM1 Suspension{ty=ty, bound_to=Just n}
-  | Just _ <- splitFunTy_maybe ty = return$ ptext SLIT("<function>")
+  | Just _ <- splitFunTy_maybe ty = return$ ptext (sLit "<function>")
   | otherwise = return$ parens$ ppr n <> text "::" <> ppr ty
 ppr_termM1 Term{}        = panic "ppr_termM1 - Term"
 ppr_termM1 RefWrap{}     = panic "ppr_termM1 - RefWrap"
@@ -386,7 +386,7 @@ ppr_termM1 NewtypeWrap{} = panic "ppr_termM1 - NewtypeWrap"
 pprNewtypeWrap y p NewtypeWrap{ty=ty, wrapped_term=t} 
   | Just (tc,_) <- splitNewTyConApp_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
@@ -670,11 +670,11 @@ cvObtainTerm hsc_env bound force mb_ty hval = runTR hsc_env $ do
   reOrderTerms _ _ [] = []
   reOrderTerms pointed unpointed (ty:tys) 
    | isPointed ty = ASSERT2(not(null pointed)
-                            , ptext SLIT("reOrderTerms") $$ 
+                            , ptext (sLit "reOrderTerms") $$ 
                                         (ppr pointed $$ ppr unpointed))
                     let (t:tt) = pointed in t : reOrderTerms tt unpointed tys
    | otherwise    = ASSERT2(not(null unpointed)
-                           , ptext SLIT("reOrderTerms") $$ 
+                           , ptext (sLit "reOrderTerms") $$ 
                                        (ppr pointed $$ ppr unpointed))
                     let (t:tt) = unpointed in t : reOrderTerms pointed tt tys
   
@@ -682,7 +682,7 @@ cvObtainTerm hsc_env bound force mb_ty hval = runTR hsc_env $ do
    | Just (tc, args) <- splitNewTyConApp_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'