X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fghci%2FRtClosureInspect.hs;h=a62e8ed59c6d7278a5b9a02306ef763f72b5cc7d;hb=fc9bbbab3fe56cf0ff5723abbdb0f496d257f34e;hp=cb16c1d39d8f32cd2b4f290f6129752fb98b1755;hpb=4fc2ca8222ca4625132ad5acf3afeb8293e42a46;p=ghc-hetmet.git

diff --git a/compiler/ghci/RtClosureInspect.hs b/compiler/ghci/RtClosureInspect.hs
index cb16c1d..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
@@ -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
@@ -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'