Outputable.cparen

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

diff --git a/compiler/ghci/RtClosureInspect.hs b/compiler/ghci/RtClosureInspect.hs
index 96edf90..e24b942 100644 (file)
--- a/compiler/ghci/RtClosureInspect.hs
+++ b/compiler/ghci/RtClosureInspect.hs
@@ -496,9 +496,10 @@ cvObtainTerm1 hsc_env force mb_ty hval = runTR hsc_env $ do
    tv <- case (isMonomorphic `fmap` mb_ty) of
           Just True -> return (fromJust mb_ty)
           _         -> do
-            tv   <- liftM mkTyVarTy (newVar argTypeKind)
-            instScheme (sigmaType$ fromJust mb_ty) >>= addConstraint tv
-            return tv
+            tv_ <- liftM mkTyVarTy (newVar argTypeKind)
+            when (isJust mb_ty) $ 
+                 instScheme (sigmaType$ fromJust mb_ty) >>= addConstraint tv_
+            return tv_
    go tv (fromMaybe tv mb_ty) hval
     where 
   go tv ty a = do 
@@ -535,7 +536,7 @@ cvObtainTerm1 hsc_env force mb_ty hval = runTR hsc_env $ do
                 subTerms   = reOrderTerms subTermsP subTermsNP (drop extra_args subTtypes)
             return (Term tv dc a subTerms)
 -- The otherwise case: can be a Thunk,AP,PAP,etc.
-      otherwise -> do
+      otherwise -> 
          return (Suspension (tipe clos) (Just tv) a Nothing)
 
 -- Access the array of pointers and recurse down. Needs to be done with
@@ -555,11 +556,12 @@ cvObtainTerm1 hsc_env force mb_ty hval = runTR hsc_env $ do
 --  correct order.
   reOrderTerms _ _ [] = []
   reOrderTerms pointed unpointed (ty:tys) 
-   | isPointed ty = head pointed : reOrderTerms (tailSafe "reorderTerms1" pointed) unpointed tys
-   | otherwise    = head unpointed : reOrderTerms pointed (tailSafe "reorderTerms2" unpointed) tys
-
-tailSafe msg [] = error msg
-tailSafe _ (x:xs) = xs 
+   | isPointed ty = ASSERT2(not(null pointed)
+                           , ptext SLIT("reOrderTerms") $$ (ppr pointed $$ ppr unpointed))
+                    head pointed : reOrderTerms (tail pointed) unpointed tys
+   | otherwise    = ASSERT2(not(null unpointed)
+                           , ptext SLIT("reOrderTerms") $$ (ppr pointed $$ ppr unpointed))
+                    head unpointed : reOrderTerms pointed (tail unpointed) tys
 
 isMonomorphic = isEmptyVarSet . tyVarsOfType