From c9bcc18e7aaa51677f7e2aa1efb2f80c6e2dff8d Mon Sep 17 00:00:00 2001
From: Pepe Iborra <mnislaih@gmail.com>
Date: Wed, 12 Sep 2007 15:35:05 +0000
Subject: [PATCH] GHCi debugger: Added a -fprint-evld-with-show flag

    The flag enables the use of Show instances in :print.
    By default they are not used anymore
---
 compiler/ghci/Debugger.hs  |    7 ++++++-
 compiler/main/DynFlags.hs  |    2 ++
 docs/users_guide/flags.xml |    6 ++++++
 docs/users_guide/ghci.xml  |    9 +++++++++
 4 files changed, 23 insertions(+), 1 deletion(-)

diff --git a/compiler/ghci/Debugger.hs b/compiler/ghci/Debugger.hs
index 179f684..5833e26 100644
--- a/compiler/ghci/Debugger.hs
+++ b/compiler/ghci/Debugger.hs
@@ -25,6 +25,7 @@ import Name
 import UniqSupply
 import TcType
 import GHC
+import DynFlags
 import InteractiveEval
 import Outputable
 import Pretty                    ( Mode(..), showDocWith )
@@ -138,7 +139,11 @@ bindSuspensions cms@(Session ref) t = do
 
 --  A custom Term printer to enable the use of Show instances
 showTerm :: Session -> Term -> IO SDoc
-showTerm cms@(Session ref) = cPprTerm (liftM2 (++) cPprShowable cPprTermBase)
+showTerm cms@(Session ref) term = do
+    dflags       <- GHC.getSessionDynFlags cms
+    if dopt Opt_PrintEvldWithShow dflags
+       then cPprTerm (liftM2 (++) cPprShowable cPprTermBase) term
+       else cPprTerm cPprTermBase term
  where
   cPprShowable _y = [\prec ty _ val tt ->
     if not (all isFullyEvaluatedTerm tt)
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 38591f0..c36a402 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -266,6 +266,7 @@ data DynFlag
    | Opt_Hpc_No_Auto
    | Opt_BreakOnException
    | Opt_BreakOnError
+   | Opt_PrintEvldWithShow
    | Opt_GenManifest
    | Opt_EmbedManifest
    | Opt_RunCPSZ
@@ -1192,6 +1193,7 @@ fFlags = [
   ( "rewrite-rules",                    Opt_RewriteRules ),
   ( "break-on-exception",               Opt_BreakOnException ),
   ( "break-on-error",                   Opt_BreakOnError ),
+  ( "print-evld-with-show",             Opt_PrintEvldWithShow ),
   ( "run-cps",                          Opt_RunCPSZ ),
   ( "convert-to-zipper-and-back",       Opt_ConvertToZipCfgAndBack),
   ( "vectorise",                        Opt_Vectorise ),
diff --git a/docs/users_guide/flags.xml b/docs/users_guide/flags.xml
index b417f7e..d706f11 100644
--- a/docs/users_guide/flags.xml
+++ b/docs/users_guide/flags.xml
@@ -515,6 +515,12 @@
 	      <entry><option>-fno-break-on-error</option></entry>
 	    </row>
 	    <row>
+	      <entry><option>-fprint-evld-with-show</option></entry>
+	      <entry><link linkend="breakpoints">Enable usage of Show instances in <literal>:print</literal></link></entry>
+	      <entry>dynamic</entry>
+	      <entry><option>-fno-print-evld-with-show</option></entry>
+	    </row>	    
+	    <row>
 	      <entry><option>-fno-print-bind-result</option></entry>
 	      <entry><link linkend="ghci-stmts">Turn off printing of binding results in GHCi</link></entry>
 	      <entry>dynamic</entry>
diff --git a/docs/users_guide/ghci.xml b/docs/users_guide/ghci.xml
index b1e36ec..579cf23 100644
--- a/docs/users_guide/ghci.xml
+++ b/docs/users_guide/ghci.xml
@@ -929,6 +929,7 @@ right :: [a]
         <literal>left</literal>:</para>
 
 <screen>
+[qsort.hs:2:15-46] *Main> :set -fprint-evld-with-show
 [qsort.hs:2:15-46] *Main> :print left
 left = (_t1::[a])
 </screen>
@@ -948,6 +949,13 @@ left = (_t1::[a])
         underscore, in this case
         <literal>_t1</literal>.</para>
 
+      <para>The flag <literal>-fprint-evld-with-show</literal> instructs
+      <literal>:print</literal> to reuse
+      available <literal>Show</literal> instances when possible. This happens
+      only when the contents of the variable being inspected 
+      are completely evaluated.</para>
+
+
       <para>If we aren't concerned about preserving the evaluatedness of a
         variable, we can use <literal>:force</literal> instead of
         <literal>:print</literal>.  The <literal>:force</literal> command
@@ -1017,6 +1025,7 @@ right :: [a]
       <para>The execution continued at the point it previously stopped, and has
         now stopped at the breakpoint for a second time.</para>
 
+
       <sect3 id="setting-breakpoints">
         <title>Setting breakpoints</title>
 
-- 
1.7.10.4