[commit: ghc] master: Introduce -dsuppress-stg-free-vars flag (cbd6a4d)

git at git.haskell.org git at git.haskell.org
Thu Nov 2 21:04:15 UTC 2017


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

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

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

commit cbd6a4d05bf382641b108347218dfd534dc57558
Author: Ben Gamari <bgamari.foss at gmail.com>
Date:   Thu Nov 2 13:32:21 2017 -0400

    Introduce -dsuppress-stg-free-vars flag
    
    This breaks out control over STG free variable list output from
    -dppr-debug into its own distinct flag. This makes it more discoverable
    and easier to change independently from other dump output.
    
    Test Plan: Validate
    
    Reviewers: austin
    
    Subscribers: rwbarton, thomie
    
    Differential Revision: https://phabricator.haskell.org/D4140


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

cbd6a4d05bf382641b108347218dfd534dc57558
 compiler/main/DynFlags.hs                                  |  3 +++
 compiler/stgSyn/StgSyn.hs                                  |  9 ++++++---
 docs/users_guide/debugging.rst                             | 12 ++++++++++++
 testsuite/tests/simplCore/should_compile/noinline01.stderr |  8 ++++----
 4 files changed, 25 insertions(+), 7 deletions(-)

diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 904257e..a421284 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -563,6 +563,7 @@ data GeneralFlag
    -- Except for uniques, as some simplifier phases introduce new
    -- variables that have otherwise identical names.
    | Opt_SuppressUniques
+   | Opt_SuppressStgFreeVars
    | Opt_SuppressTicks     -- Replaces Opt_PprShowTicks
 
    -- temporary flags
@@ -2916,6 +2917,7 @@ dynamic_flags_deps = [
                   setGeneralFlag Opt_SuppressTypeApplications
                   setGeneralFlag Opt_SuppressIdInfo
                   setGeneralFlag Opt_SuppressTicks
+                  setGeneralFlag Opt_SuppressStgFreeVars
                   setGeneralFlag Opt_SuppressTypeSignatures)
 
         ------ Debugging ----------------------------------------------------
@@ -3689,6 +3691,7 @@ dFlagsDeps = [
   depFlagSpec' "ppr-ticks"              Opt_PprShowTicks
      (\turn_on -> useInstead "-d" "suppress-ticks" (not turn_on)),
   flagSpec "suppress-ticks"             Opt_SuppressTicks,
+  flagSpec "suppress-stg-free-vars"     Opt_SuppressStgFreeVars,
   flagSpec "suppress-coercions"         Opt_SuppressCoercions,
   flagSpec "suppress-idinfo"            Opt_SuppressIdInfo,
   flagSpec "suppress-unfoldings"        Opt_SuppressUnfoldings,
diff --git a/compiler/stgSyn/StgSyn.hs b/compiler/stgSyn/StgSyn.hs
index b31a8fc..330e2b4 100644
--- a/compiler/stgSyn/StgSyn.hs
+++ b/compiler/stgSyn/StgSyn.hs
@@ -803,9 +803,11 @@ pprStgRhs :: (OutputableBndr bndr, Outputable bdee, Ord bdee)
 
 -- special case
 pprStgRhs (StgRhsClosure cc bi [free_var] upd_flag [{-no args-}] (StgApp func []))
-  = hsep [ ppr cc,
+  = sdocWithDynFlags $ \dflags ->
+    hsep [ ppr cc,
            pp_binder_info bi,
-           brackets (whenPprDebug (ppr free_var)),
+           if not $ gopt Opt_SuppressStgFreeVars dflags
+             then brackets (ppr free_var) else empty,
            text " \\", ppr upd_flag, ptext (sLit " [] "), ppr func ]
 
 -- general case
@@ -813,7 +815,8 @@ pprStgRhs (StgRhsClosure cc bi free_vars upd_flag args body)
   = sdocWithDynFlags $ \dflags ->
     hang (hsep [if gopt Opt_SccProfilingOn dflags then ppr cc else empty,
                 pp_binder_info bi,
-                whenPprDebug (brackets (interppSP free_vars)),
+                if not $ gopt Opt_SuppressStgFreeVars dflags
+                  then brackets (interppSP free_vars) else empty,
                 char '\\' <> ppr upd_flag, brackets (interppSP args)])
          4 (ppr body)
 
diff --git a/docs/users_guide/debugging.rst b/docs/users_guide/debugging.rst
index 4e071a2..0d3872e 100644
--- a/docs/users_guide/debugging.rst
+++ b/docs/users_guide/debugging.rst
@@ -659,6 +659,18 @@ parts that you are not interested in.
 
     Suppress the printing of type coercions.
 
+.. ghc-flag:: -dsuppress-var-kinds
+    :shortdesc: Suppress the printing of variable kinds
+    :type: dynamic
+
+    Suppress the printing of variable kinds
+
+.. ghc-flag:: -dsuppress-stg-free-vars
+    :shortdesc: Suppress the printing of closure free variable lists in STG output
+    :type: dynamic
+
+    Suppress the printing of closure free variable lists in STG output
+
 
 .. _checking-consistency:
 
diff --git a/testsuite/tests/simplCore/should_compile/noinline01.stderr b/testsuite/tests/simplCore/should_compile/noinline01.stderr
index 1bb98e5..53db7da 100644
--- a/testsuite/tests/simplCore/should_compile/noinline01.stderr
+++ b/testsuite/tests/simplCore/should_compile/noinline01.stderr
@@ -3,11 +3,11 @@
 Noinline01.f [InlPrag=INLINE (sat-args=1)]
   :: forall p. p -> GHC.Types.Bool
 [GblId, Arity=1, Caf=NoCafRefs, Str=<L,A>, Unf=OtherCon []] =
-    \r [eta] GHC.Types.True [];
+    [] \r [eta] GHC.Types.True [];
 
 Noinline01.g :: GHC.Types.Bool
 [GblId] =
-    \u [] Noinline01.f GHC.Types.False;
+    [] \u [] Noinline01.f GHC.Types.False;
 
 Noinline01.$trModule4 :: GHC.Prim.Addr#
 [GblId, Caf=NoCafRefs, Unf=OtherCon []] =
@@ -36,11 +36,11 @@ Noinline01.$trModule :: GHC.Types.Module
 Noinline01.f [InlPrag=INLINE (sat-args=1)]
   :: forall p. p -> GHC.Types.Bool
 [GblId, Arity=1, Caf=NoCafRefs, Str=<L,A>, Unf=OtherCon []] =
-    \r [eta] GHC.Types.True [];
+    [] \r [eta] GHC.Types.True [];
 
 Noinline01.g :: GHC.Types.Bool
 [GblId] =
-    \u [] Noinline01.f GHC.Types.False;
+    [] \u [] Noinline01.f GHC.Types.False;
 
 Noinline01.$trModule4 :: GHC.Prim.Addr#
 [GblId, Caf=NoCafRefs, Unf=OtherCon []] =



More information about the ghc-commits mailing list