X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fghci%2FRtClosureInspect.hs;h=1b8616aaabcd2e9a74f8f05374344d7dcb47e45a;hb=251fc4cd2669ab3c8621c0ad3419669e090618d1;hp=3702ec4b3b384c805947cde85f644f9754a44008;hpb=e314b86f6290e5440a46cd5cc29f7878cb78c6fb;p=ghc-hetmet.git diff --git a/compiler/ghci/RtClosureInspect.hs b/compiler/ghci/RtClosureInspect.hs index 3702ec4..1b8616a 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("") + | Just _ <- splitFunTy_maybe ty = return$ ptext (sLit "") | otherwise = return$ parens$ ppr n <> text "::" <> ppr ty ppr_termM1 Term{} = panic "ppr_termM1 - Term" ppr_termM1 RefWrap{} = panic "ppr_termM1 - RefWrap" @@ -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