X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fghci%2FDebugger.hs;h=a43d4fdf9556405b7ba4b50029ed0b32b200edad;hb=beab356b7fbda6281351d7edd556d2e77a351cbf;hp=19a9e999ae70808d650b8bd1396bcc2bfca300cb;hpb=67f8c4685920582ad82000e7840a1ffe91682f35;p=ghc-hetmet.git

diff --git a/compiler/ghci/Debugger.hs b/compiler/ghci/Debugger.hs
index 19a9e99..a43d4fd 100644
--- a/compiler/ghci/Debugger.hs
+++ b/compiler/ghci/Debugger.hs
@@ -66,8 +66,8 @@ pprintClosureCommand bindThings force str = do
            uniques <- liftM uniqsFromSupply (mkSplitUniqSupply 'q')
            return$ map (\u-> (mkSysTvName u (mkFastString "a"))) uniques
   mb_ids  <- io$ mapM (cleanUp cms newvarsNames) (words str)
-  new_ids <- mapM (io . go cms) (catMaybes mb_ids)
-  io$ updateIds cms new_ids
+  mb_new_ids <- mapM (io . go cms) (catMaybes mb_ids)
+  io$ updateIds cms (catMaybes mb_new_ids)
  where 
    -- Find the Id, clean up 'Unknowns'
    cleanUp :: Session -> [Name] -> String -> IO (Maybe Id)
@@ -78,22 +78,23 @@ pprintClosureCommand bindThings force str = do
 
    -- Do the obtainTerm--bindSuspensions-refineIdType dance
    -- Warning! This function got a good deal of side-effects
-   go :: Session -> Id -> IO Id
+   go :: Session -> Id -> IO (Maybe Id)
    go cms id = do
-     Just term <- obtainTerm cms force id
-     term'     <- if not bindThings then return term 
-                   else bindSuspensions cms term                         
-     showterm  <- pprTerm cms term'
-     unqual    <- GHC.getPrintUnqual cms
-     let showSDocForUserOneLine unqual doc = 
-             showDocWith LeftMode (doc (mkErrStyle unqual))
-     (putStrLn . showSDocForUserOneLine unqual) (ppr id <+> char '=' <+> showterm)
+     mb_term <- obtainTerm cms force id
+     maybe (return Nothing) `flip` mb_term $ \term -> do
+       term'     <- if not bindThings then return term 
+                     else bindSuspensions cms term                         
+       showterm  <- pprTerm cms term'
+       unqual    <- GHC.getPrintUnqual cms
+       let showSDocForUserOneLine unqual doc = 
+               showDocWith LeftMode (doc (mkErrStyle unqual))
+       (putStrLn . showSDocForUserOneLine unqual) (ppr id <+> char '=' <+> showterm)
      -- Before leaving, we compare the type obtained to see if it's more specific
      -- Note how we need the Unknown-clear type returned by obtainTerm
-     let Just reconstructedType = termType term  
-     new_type  <- instantiateTyVarsToUnknown cms 
-                  (mostSpecificType (idType id) reconstructedType)
-     return (setIdType id new_type)
+       let Just reconstructedType = termType term  
+       new_type  <- instantiateTyVarsToUnknown cms 
+                    (mostSpecificType (idType id) reconstructedType)
+       return . Just $ setIdType id new_type
 
    updateIds :: Session -> [Id] -> IO ()
    updateIds (Session ref) new_ids = do
@@ -299,7 +300,6 @@ stripUnknowns names id = setIdType id . fst . go names . idType
            kind1 = mkArrowKind liftedTypeKind liftedTypeKind
            kind2 = mkArrowKind kind1 liftedTypeKind
            kind3 = mkArrowKind kind2 liftedTypeKind
-stripUnknowns _ id = id
 
 -----------------------------
 -- | The :breakpoint command