[commit: ghc] master: New flag: -ddump-strsigs (3f6da56)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/3f6da561a9d71030efbab20544c4f77f9da0759d/ghc

>---------------------------------------------------------------

commit 3f6da561a9d71030efbab20544c4f77f9da0759d
Author: Joachim Breitner <mail at joachim-breitner.de>
Date:   Mon Dec 9 15:29:21 2013 +0000

    New flag: -ddump-strsigs
    
    The existing flag -ddump-stranal dumps the full Core, which is very
    verbose and not always helpful. This adds a more concise output (one
    line per top-level bind) that is faster to read, and especially more
    suitable to be used when writing test cases for the strictness analiser.


>---------------------------------------------------------------

3f6da561a9d71030efbab20544c4f77f9da0759d
 compiler/main/DynFlags.hs      |    2 ++
 compiler/stranal/DmdAnal.lhs   |   12 ++++++++++++
 docs/users_guide/debugging.xml |   10 ++++++++++
 docs/users_guide/flags.xml     |    6 ++++++
 4 files changed, 30 insertions(+)

diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 05a72d6..70d2a81 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -242,6 +242,7 @@ data DumpFlag
    | Opt_D_dump_prep
    | Opt_D_dump_stg
    | Opt_D_dump_stranal
+   | Opt_D_dump_strsigs
    | Opt_D_dump_tc
    | Opt_D_dump_types
    | Opt_D_dump_rules
@@ -2311,6 +2312,7 @@ dynamic_flags = [
   , Flag "ddump-prep"              (setDumpFlag Opt_D_dump_prep)
   , Flag "ddump-stg"               (setDumpFlag Opt_D_dump_stg)
   , Flag "ddump-stranal"           (setDumpFlag Opt_D_dump_stranal)
+  , Flag "ddump-strsigs"           (setDumpFlag Opt_D_dump_strsigs)
   , Flag "ddump-tc"                (setDumpFlag Opt_D_dump_tc)
   , Flag "ddump-types"             (setDumpFlag Opt_D_dump_types)
   , Flag "ddump-rules"             (setDumpFlag Opt_D_dump_rules)
diff --git a/compiler/stranal/DmdAnal.lhs b/compiler/stranal/DmdAnal.lhs
index 99eb7ac..0ceb7c9 100644
--- a/compiler/stranal/DmdAnal.lhs
+++ b/compiler/stranal/DmdAnal.lhs
@@ -35,6 +35,7 @@ import Util
 import Maybes		( isJust, orElse )
 import TysWiredIn	( unboxedPairDataCon )
 import TysPrim		( realWorldStatePrimTy )
+import ErrUtils         ( dumpIfSet_dyn )
 \end{code}
 
 %************************************************************************
@@ -48,6 +49,8 @@ dmdAnalProgram :: DynFlags -> CoreProgram -> IO CoreProgram
 dmdAnalProgram dflags binds
   = do {
 	let { binds_plus_dmds = do_prog binds } ;
+        dumpIfSet_dyn dflags Opt_D_dump_strsigs "Strictness signatures" $
+            dumpStrSig binds_plus_dmds ;
 	return binds_plus_dmds
     }
   where
@@ -1100,6 +1103,15 @@ set_idDemandInfo env id dmd
 set_idStrictness :: AnalEnv -> Id -> StrictSig -> Id
 set_idStrictness env id sig
   = setIdStrictness id (zapStrictSig (ae_dflags env) sig)
+
+dumpStrSig :: CoreProgram -> SDoc
+dumpStrSig binds = vcat (concatMap goBind binds)
+  where
+  goBind (NonRec i _) = [ goId i ]
+  goBind (Rec bs)     = map (goId . fst) bs
+  goId id | isExportedId id = ppr id <> colon <+> pprIfaceStrictSig (idStrictness id)
+          | otherwise       = empty
+
 \end{code}
 
 Note [Initial CPR for strict binders]
diff --git a/docs/users_guide/debugging.xml b/docs/users_guide/debugging.xml
index 003d2b5..5130345 100644
--- a/docs/users_guide/debugging.xml
+++ b/docs/users_guide/debugging.xml
@@ -202,6 +202,16 @@
 
 	    <varlistentry>
 	      <term>
+	        <option>-ddump-strsigs</option>:
+                <indexterm><primary><option>-ddump-strsigs</option></primary></indexterm>
+	      </term>
+	      <listitem>
+		<para>strictness signatures</para>
+	      </listitem>
+	    </varlistentry>
+
+	    <varlistentry>
+	      <term>
 	        <option>-ddump-cse</option>:
                 <indexterm><primary><option>-ddump-cse</option></primary></indexterm>
 	      </term>
diff --git a/docs/users_guide/flags.xml b/docs/users_guide/flags.xml
index 72ef91e..2422b9d 100644
--- a/docs/users_guide/flags.xml
+++ b/docs/users_guide/flags.xml
@@ -2817,6 +2817,12 @@
             <entry>-</entry>
           </row>
           <row>
+            <entry><option>-ddump-strsigs</option></entry>
+            <entry>Dump strictness signatures</entry>
+            <entry>dynamic</entry>
+            <entry>-</entry>
+          </row>
+          <row>
             <entry><option>-ddump-tc</option></entry>
             <entry>Dump typechecker output</entry>
             <entry>dynamic</entry>