Style: remove trailing spaces
[ghc-hetmet.git] / compiler / ghci / InteractiveUI.hs
index abc75bd..dffae16 100644 (file)
@@ -186,6 +186,7 @@ helpText =
  "   :sprint [<name> ...]        simplifed version of :print\n" ++
  "   :step                       single-step after stopping at a breakpoint\n"++
  "   :step <expr>                single-step into <expr>\n"++
+ "   :stepover                   single-step without following function applications\n"++
  "   :trace                      trace after stopping at a breakpoint\n"++
  "   :trace <expr>               trace into <expr> (remembers breakpoints for :history)\n"++
 
@@ -577,7 +578,8 @@ afterRunStmt pred run_result = do
            pred (GHC.resumeSpan $ head resumes) -> do
                printForUser $ ptext SLIT("Stopped at") <+> 
                        ppr (GHC.resumeSpan $ head resumes)
-               printTypeOfNames session names
+--               printTypeOfNames session names
+               printTypeAndContentOfNames session names
                maybe (return ()) runBreakCmd mb_info
                -- run the command set with ":set stop <cmd>"
                st <- getGHCiState
@@ -594,6 +596,18 @@ afterRunStmt pred run_result = do
 
   return (case run_result of GHC.RunOk _ -> True; _ -> False)
 
+      where printTypeAndContentOfNames session names = do
+              let namesSorted = sortBy compareNames names
+              tythings <- catMaybes `liftM` 
+                              io (mapM (GHC.lookupName session) names)
+              docs_ty  <- mapM showTyThing tythings
+              terms    <- mapM (io . GHC.obtainTerm session False)
+                               [ id | (AnId id, Just _) <- zip tythings docs_ty]
+              docs_terms <- mapM (io . showTerm session) terms                                   
+              printForUser $ vcat $ zipWith (\ty cts -> ty <> text " = " <> cts)
+                                            (catMaybes docs_ty)
+                                            docs_terms
+
 runBreakCmd :: GHC.BreakInfo -> GHCi ()
 runBreakCmd info = do
   let mod = GHC.breakInfo_module info
@@ -666,7 +680,7 @@ getCurrentBreakModule = do
     (r:rs) -> do
         let ix = GHC.resumeHistoryIx r
         if ix == 0
-           then return (GHC.breakInfo_module `fmap` GHC.resumeBreakInfo r)
+           then return (GHC.breakInfo_module `liftM` GHC.resumeBreakInfo r)
            else do
                 let hist = GHC.resumeHistory r !! (ix-1)
                 return $ Just $ GHC.getHistoryModule  hist
@@ -892,8 +906,6 @@ checkModule m = do
 
 reloadModule :: String -> GHCi ()
 reloadModule m = do
-  io (revertCAFs)              -- always revert CAFs on reload.
-  discardActiveBreakPoints
   session <- getSession
   doLoad session $ if null m then LoadAllTargets 
                              else LoadUpTo (GHC.mkModuleName m)
@@ -1277,11 +1289,18 @@ showBindings = do
 compareTyThings :: TyThing -> TyThing -> Ordering
 t1 `compareTyThings` t2 = getName t1 `compareNames` getName t2
 
-printTyThing :: TyThing -> GHCi ()
-printTyThing (AnId id) = do
+showTyThing :: TyThing -> GHCi (Maybe SDoc)
+showTyThing (AnId id) = do
   ty' <- cleanType (GHC.idType id)
-  printForUser $ ppr id <> text " :: " <> ppr ty'
-printTyThing _ = return ()
+  return $ Just $ ppr id <> text " :: " <> ppr ty'
+showTyThing _ = return Nothing
+
+printTyThing :: TyThing -> GHCi ()
+printTyThing tyth = do
+  mb_x <- showTyThing tyth
+  case mb_x of
+    Just x  -> printForUser x
+    Nothing -> return ()
 
 -- if -fglasgow-exts is on we show the foralls, otherwise we don't.
 cleanType :: Type -> GHCi Type
@@ -1563,7 +1582,7 @@ stepOverCmd [] = do
               then doContinue (`isSubspanOf` parent) GHC.SingleStep
               else doContinue (const True) GHC.SingleStep
 
-    where 
+stepOverCmd expression = stepCmd expression
 
 {- 
  So, the only tricky part in stepOver is detecting that we have