Core pretty printer: Omit wild case binders
authorJoachim Breitner <mail@joachim-breitner.de>
Wed, 30 Mar 2016 11:22:26 +0000 (13:22 +0200)
committerJoachim Breitner <mail@joachim-breitner.de>
Wed, 6 Apr 2016 20:06:10 +0000 (22:06 +0200)
as they (especially their id info with absence information) clutter the
output too much. They come back with debug_on.

Differential Revision: https://phabricator.haskell.org/D2072

14 files changed:
compiler/coreSyn/PprCore.hs
compiler/hsSyn/HsBinds.hs
compiler/stgSyn/StgSyn.hs
compiler/utils/Outputable.hs
testsuite/tests/deSugar/should_compile/T2431.stderr
testsuite/tests/numeric/should_compile/T7116.stdout
testsuite/tests/simplCore/should_compile/T3717.stderr
testsuite/tests/simplCore/should_compile/T3772.stdout
testsuite/tests/simplCore/should_compile/T4908.stderr
testsuite/tests/simplCore/should_compile/T4930.stderr
testsuite/tests/simplCore/should_compile/T5366.stdout
testsuite/tests/simplCore/should_compile/T7360.stderr
testsuite/tests/simplCore/should_compile/T7865.stdout
testsuite/tests/simplCore/should_compile/spec-inline.stderr

index 0c62e4f..75e91a4 100644 (file)
@@ -189,14 +189,15 @@ ppr_expr add_par (Case expr var ty [(con,args,rhs)])
              , pprCoreExpr rhs
              ]
     else add_par $
-         sep [sep [text "case" <+> pprCoreExpr expr,
-                   ifPprDebug (text "return" <+> ppr ty),
-                   sep [text "of" <+> ppr_bndr var,
-                        char '{' <+> ppr_case_pat con args <+> arrow]
-               ],
-              pprCoreExpr rhs,
-              char '}'
-         ]
+         sep [sep [sep [ text "case" <+> pprCoreExpr expr
+                       , ifPprDebug (text "return" <+> ppr ty)
+                       , text "of" <+> ppr_bndr var
+                       ]
+                  , char '{' <+> ppr_case_pat con args <+> arrow
+                  ]
+              , pprCoreExpr rhs
+              , char '}'
+              ]
   where
     ppr_bndr = pprBndr CaseBind
 
@@ -259,13 +260,13 @@ ppr_case_pat (DataAlt dc) args
   | Just sort <- tyConTuple_maybe tc
   = tupleParens sort (pprWithCommas ppr_bndr args)
   where
-    ppr_bndr = pprBndr CaseBind
+    ppr_bndr = pprBndr CasePatBind
     tc = dataConTyCon dc
 
 ppr_case_pat con args
   = ppr con <+> (fsep (map ppr_bndr args))
   where
-    ppr_bndr = pprBndr CaseBind
+    ppr_bndr = pprBndr CasePatBind
 
 
 -- | Pretty print the argument in a function application.
@@ -292,6 +293,21 @@ With -dppr-case-as-let we print them as such:
 
 Other printing bits-and-bobs used with the general @pprCoreBinding@
 and @pprCoreExpr@ functions.
+
+
+Note [Binding-site specific printing]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+pprCoreBinder and pprTypedLamBinder receive a BindingSite argument to adjust
+the information printed.
+
+Let-bound binders are printed with their full type and idInfo.
+
+Case-bound variables (both the case binder and pattern variables) are printed
+without a type and without their unfolding.
+
+Furthermore, a dead case-binder is completely ignored, while otherwise, dead
+binders are printed as "_".
 -}
 
 instance OutputableBndr Var where
@@ -321,6 +337,10 @@ pprTypedLamBinder bind_site debug_on var
   = sdocWithDynFlags $ \dflags ->
     case () of
     _
+      | not debug_on            -- Show case-bound wild bilders only if debug is on
+      , CaseBind <- bind_site
+      , isDeadBinder var        -> empty
+
       | not debug_on            -- Even dead binders can be one-shot
       , isDeadBinder var        -> char '_' <+> ppWhen (isId var)
                                                 (pprIdBndrInfo (idInfo var))
@@ -328,6 +348,9 @@ pprTypedLamBinder bind_site debug_on var
       | not debug_on            -- No parens, no kind info
       , CaseBind <- bind_site   -> pprUntypedBinder var
 
+      | not debug_on
+      , CasePatBind <- bind_site    -> pprUntypedBinder var
+
       | suppress_sigs dflags    -> pprUntypedBinder var
 
       | isTyVar var  -> parens (pprKindedTyVarBndr var)
index 4d5e72c..2799c0e 100644 (file)
@@ -525,7 +525,7 @@ ppr_monobind :: (OutputableBndr idL, OutputableBndr idR) => HsBindLR idL idR ->
 ppr_monobind (PatBind { pat_lhs = pat, pat_rhs = grhss })
   = pprPatBind pat grhss
 ppr_monobind (VarBind { var_id = var, var_rhs = rhs })
-  = sep [pprBndr CaseBind var, nest 2 $ equals <+> pprExpr (unLoc rhs)]
+  = sep [pprBndr CasePatBind var, nest 2 $ equals <+> pprExpr (unLoc rhs)]
 ppr_monobind (FunBind { fun_id = fun,
                         fun_co_fn = wrap,
                         fun_matches = matches,
index 4145d9e..87bbb94 100644 (file)
@@ -740,7 +740,7 @@ pprStgExpr (StgCase expr bndr alt_type alts)
 pprStgAlt :: (OutputableBndr bndr, Outputable occ, Ord occ)
           => GenStgAlt bndr occ -> SDoc
 pprStgAlt (con, params, expr)
-  = hang (hsep [ppr con, sep (map (pprBndr CaseBind) params), text "->"])
+  = hang (hsep [ppr con, sep (map (pprBndr CasePatBind) params), text "->"])
          4 (ppr expr <> semi)
 
 pprStgOp :: StgOp -> SDoc
index 64b3542..d61b1ec 100644 (file)
@@ -837,7 +837,12 @@ instance Outputable Extension where
 -- | 'BindingSite' is used to tell the thing that prints binder what
 -- language construct is binding the identifier.  This can be used
 -- to decide how much info to print.
-data BindingSite = LambdaBind | CaseBind | LetBind
+-- Also see Note [Binding-site specific printing] in PprCore
+data BindingSite
+    = LambdaBind  -- ^ The x in   (\x. e)
+    | CaseBind    -- ^ The x in   case scrut of x { (y,z) -> ... }
+    | CasePatBind -- ^ The y,z in case scrut of x { (y,z) -> ... }
+    | LetBind     -- ^ The x in   (let x = rhs in e)
 
 -- | When we print a binder, we often want to print its type too.
 -- The @OutputableBndr@ class encapsulates this idea.
index 04069c7..43ffb06 100644 (file)
@@ -19,7 +19,7 @@ T2431.$WRefl =
 -- RHS size: {terms: 4, types: 8, coercions: 0}
 absurd :: forall a. Int :~: Bool -> a
 [GblId, Arity=1, Caf=NoCafRefs, Str=<L,U>x]
-absurd = \ (@ a) (x :: Int :~: Bool) -> case x of _ [Occ=Dead] { }
+absurd = \ (@ a) (x :: Int :~: Bool) -> case x of { }
 
 -- RHS size: {terms: 2, types: 0, coercions: 0}
 $trModule1 :: GHC.Types.TrName
index 4bbd50e..ea9fb3e 100644 (file)
@@ -40,14 +40,12 @@ dr :: Double -> Double
          WorkFree=True, Expandable=True,
          Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False)
          Tmpl= \ (x [Occ=Once!] :: Double) ->
-                 case x of _ [Occ=Dead] { GHC.Types.D# x1 ->
+                 case x of { GHC.Types.D# x1 ->
                  GHC.Types.D# (GHC.Prim.+## x1 x1)
                  }}]
 dr =
   \ (x :: Double) ->
-    case x of _ [Occ=Dead] { GHC.Types.D# x1 ->
-    GHC.Types.D# (GHC.Prim.+## x1 x1)
-    }
+    case x of { GHC.Types.D# x1 -> GHC.Types.D# (GHC.Prim.+## x1 x1) }
 
 -- RHS size: {terms: 1, types: 0, coercions: 0}
 dl :: Double -> Double
@@ -59,9 +57,7 @@ dl :: Double -> Double
          WorkFree=True, Expandable=True,
          Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False)
          Tmpl= \ (x [Occ=Once!] :: Double) ->
-                 case x of _ [Occ=Dead] { GHC.Types.D# y ->
-                 GHC.Types.D# (GHC.Prim.+## y y)
-                 }}]
+                 case x of { GHC.Types.D# y -> GHC.Types.D# (GHC.Prim.+## y y) }}]
 dl = dr
 
 -- RHS size: {terms: 8, types: 3, coercions: 0}
@@ -74,12 +70,12 @@ fr :: Float -> Float
          WorkFree=True, Expandable=True,
          Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False)
          Tmpl= \ (x [Occ=Once!] :: Float) ->
-                 case x of _ [Occ=Dead] { GHC.Types.F# x1 ->
+                 case x of { GHC.Types.F# x1 ->
                  GHC.Types.F# (GHC.Prim.plusFloat# x1 x1)
                  }}]
 fr =
   \ (x :: Float) ->
-    case x of _ [Occ=Dead] { GHC.Types.F# x1 ->
+    case x of { GHC.Types.F# x1 ->
     GHC.Types.F# (GHC.Prim.plusFloat# x1 x1)
     }
 
@@ -93,7 +89,7 @@ fl :: Float -> Float
          WorkFree=True, Expandable=True,
          Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False)
          Tmpl= \ (x [Occ=Once!] :: Float) ->
-                 case x of _ [Occ=Dead] { GHC.Types.F# y ->
+                 case x of { GHC.Types.F# y ->
                  GHC.Types.F# (GHC.Prim.plusFloat# y y)
                  }}]
 fl = fr
index 66a14f1..a7c1e55 100644 (file)
@@ -53,12 +53,12 @@ foo [InlPrag=INLINE[0]] :: Int -> Int
          WorkFree=True, Expandable=True,
          Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False)
          Tmpl= \ (w [Occ=Once!] :: Int) ->
-                 case w of _ [Occ=Dead] { GHC.Types.I# ww1 [Occ=Once] ->
+                 case w of { GHC.Types.I# ww1 [Occ=Once] ->
                  case T3717.$wfoo ww1 of ww2 { __DEFAULT -> GHC.Types.I# ww2 }
                  }}]
 foo =
   \ (w :: Int) ->
-    case w of _ [Occ=Dead] { GHC.Types.I# ww1 ->
+    case w of { GHC.Types.I# ww1 ->
     case T3717.$wfoo ww1 of ww2 { __DEFAULT -> GHC.Types.I# ww2 }
     }
 
index fdbcc88..d70c0ee 100644 (file)
@@ -19,9 +19,8 @@ foo [InlPrag=NOINLINE] :: Int -> ()
 [GblId, Arity=1, Caf=NoCafRefs, Str=<S(S),1*U(U)>]
 foo =
   \ (n :: Int) ->
-    case n of _ [Occ=Dead] { GHC.Types.I# y ->
-    case GHC.Prim.tagToEnum# @ Bool (GHC.Prim.<# 0# y)
-    of _ [Occ=Dead] {
+    case n of { GHC.Types.I# y ->
+    case GHC.Prim.tagToEnum# @ Bool (GHC.Prim.<# 0# y) of {
       False -> GHC.Tuple.();
       True -> $wxs y
     }
index 2137dd8..947d16a 100644 (file)
@@ -58,8 +58,8 @@ T4908.$wf =
   \ (ww :: Int#) (w :: (Int, Int)) ->
     case ww of ds {
       __DEFAULT ->
-        case w of _ [Occ=Dead] { (a, b) ->
-        case b of _ [Occ=Dead] { I# ds1 ->
+        case w of { (a, b) ->
+        case b of { I# ds1 ->
         case ds1 of ds2 {
           __DEFAULT -> T4908.f_$s$wf a ds2 (-# ds 1#);
           0# -> GHC.Types.True
@@ -79,10 +79,10 @@ f [InlPrag=INLINE[0]] :: Int -> (Int, Int) -> Bool
          WorkFree=True, Expandable=True,
          Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False)
          Tmpl= \ (w [Occ=Once!] :: Int) (w1 [Occ=Once] :: (Int, Int)) ->
-                 case w of _ [Occ=Dead] { I# ww1 [Occ=Once] -> T4908.$wf ww1 w1 }}]
+                 case w of { I# ww1 [Occ=Once] -> T4908.$wf ww1 w1 }}]
 f =
   \ (w :: Int) (w1 :: (Int, Int)) ->
-    case w of _ [Occ=Dead] { I# ww1 -> T4908.$wf ww1 w1 }
+    case w of { I# ww1 -> T4908.$wf ww1 w1 }
 
 
 ------ Local rules for imported ids --------
index e6045a3..7e51aa6 100644 (file)
@@ -37,13 +37,13 @@ T4930.$wfoo [InlPrag=[0], Occ=LoopBreaker]
 [GblId, Arity=1, Caf=NoCafRefs, Str=<S,U>]
 T4930.$wfoo =
   \ (ww :: GHC.Prim.Int#) ->
-    case case GHC.Prim.tagToEnum# @ Bool (GHC.Prim.<# ww 5#)
-         of _ [Occ=Dead] {
+    case case GHC.Prim.tagToEnum# @ Bool (GHC.Prim.<# ww 5#) of {
            False -> GHC.Types.I# (GHC.Prim.+# ww 2#);
            True ->
              case T4930.$wfoo ww of ww1 { __DEFAULT -> GHC.Types.I# ww1 }
          }
-    of _ [Occ=Dead] { GHC.Types.I# ipv ->
+    of
+    { GHC.Types.I# ipv ->
     GHC.Prim.+# ww 5#
     }
 end Rec }
@@ -58,12 +58,12 @@ foo [InlPrag=INLINE[0]] :: Int -> Int
          WorkFree=True, Expandable=True,
          Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False)
          Tmpl= \ (w [Occ=Once!] :: Int) ->
-                 case w of _ [Occ=Dead] { GHC.Types.I# ww1 [Occ=Once] ->
+                 case w of { GHC.Types.I# ww1 [Occ=Once] ->
                  case T4930.$wfoo ww1 of ww2 { __DEFAULT -> GHC.Types.I# ww2 }
                  }}]
 foo =
   \ (w :: Int) ->
-    case w of _ [Occ=Dead] { GHC.Types.I# ww1 ->
+    case w of { GHC.Types.I# ww1 ->
     case T4930.$wfoo ww1 of ww2 { __DEFAULT -> GHC.Types.I# ww2 }
     }
 
index df0f9ba..735d059 100644 (file)
@@ -1 +1,2 @@
-    case ds of _ [Occ=Dead] { Bar dt dt1 -> GHC.Types.I# dt }
+                 case ds of { Bar dt [Occ=Once] _ [Occ=Dead] -> GHC.Types.I# dt }}]
+f = \ (ds :: Bar) -> case ds of { Bar dt dt1 -> GHC.Types.I# dt }
index f9c0215..4598b3e 100644 (file)
@@ -12,21 +12,15 @@ T7360.$WFoo3 [InlPrag=INLINE] :: Int -> Foo
          WorkFree=True, Expandable=True,
          Guidance=ALWAYS_IF(arity=1,unsat_ok=False,boring_ok=False)
          Tmpl= \ (dt [Occ=Once!] :: Int) ->
-                 case dt of _ [Occ=Dead] { GHC.Types.I# dt [Occ=Once] ->
-                 T7360.Foo3 dt
-                 }}]
+                 case dt of { GHC.Types.I# dt [Occ=Once] -> T7360.Foo3 dt }}]
 T7360.$WFoo3 =
   \ (dt [Occ=Once!] :: Int) ->
-    case dt of _ [Occ=Dead] { GHC.Types.I# dt [Occ=Once] ->
-    T7360.Foo3 dt
-    }
+    case dt of { GHC.Types.I# dt [Occ=Once] -> T7360.Foo3 dt }
 
 -- RHS size: {terms: 5, types: 2, coercions: 0}
 fun1 [InlPrag=NOINLINE] :: Foo -> ()
 [GblId, Arity=1, Caf=NoCafRefs, Str=<S,1*U>]
-fun1 =
-  \ (x :: Foo) ->
-    case x of _ [Occ=Dead] { __DEFAULT -> GHC.Tuple.() }
+fun1 = \ (x :: Foo) -> case x of { __DEFAULT -> GHC.Tuple.() }
 
 -- RHS size: {terms: 2, types: 0, coercions: 0}
 T7360.fun5 :: ()
index b06e47d..7cad614 100644 (file)
@@ -1,4 +1,4 @@
 expensive [InlPrag=NOINLINE] :: Int -> Int
 expensive =
-        case expensive sc1 of _ [Occ=Dead] { GHC.Types.I# x ->
-                (case expensive x of _ [Occ=Dead] { GHC.Types.I# x1 ->
+        case expensive sc1 of { GHC.Types.I# x ->
+                (case expensive x of { GHC.Types.I# x1 ->
index a1dc514..441b4ed 100644 (file)
@@ -56,14 +56,11 @@ Roman.foo_$s$wgo =
                 (GHC.Prim.+# (GHC.Prim.+# (GHC.Prim.+# sc sc) sc) sc) sc)
              sc)
           sc } in
-    case GHC.Prim.tagToEnum# @ Bool (GHC.Prim.<=# sc1 0#)
-    of _ [Occ=Dead] {
+    case GHC.Prim.tagToEnum# @ Bool (GHC.Prim.<=# sc1 0#) of {
       False ->
-        case GHC.Prim.tagToEnum# @ Bool (GHC.Prim.<# sc1 100#)
-        of _ [Occ=Dead] {
+        case GHC.Prim.tagToEnum# @ Bool (GHC.Prim.<# sc1 100#) of {
           False ->
-            case GHC.Prim.tagToEnum# @ Bool (GHC.Prim.<# sc1 500#)
-            of _ [Occ=Dead] {
+            case GHC.Prim.tagToEnum# @ Bool (GHC.Prim.<# sc1 500#) of {
               False -> Roman.foo_$s$wgo (GHC.Prim.+# m m) (GHC.Prim.-# sc1 1#);
               True -> Roman.foo_$s$wgo m (GHC.Prim.-# sc1 3#)
             };
@@ -82,10 +79,10 @@ Roman.$wgo [InlPrag=[0]] :: Maybe Int -> Maybe Int -> GHC.Prim.Int#
          WorkFree=True, Expandable=True, Guidance=IF_ARGS [60 30] 256 0}]
 Roman.$wgo =
   \ (w :: Maybe Int) (w1 :: Maybe Int) ->
-    case w1 of _ [Occ=Dead] {
+    case w1 of {
       Nothing -> case Roman.foo3 of wild1 { };
       Just x ->
-        case x of _ [Occ=Dead] { GHC.Types.I# ipv ->
+        case x of { GHC.Types.I# ipv ->
         let {
           m :: GHC.Prim.Int#
           [LclId]
@@ -96,18 +93,15 @@ Roman.$wgo =
                     (GHC.Prim.+# (GHC.Prim.+# (GHC.Prim.+# ipv ipv) ipv) ipv) ipv)
                  ipv)
               ipv } in
-        case w of _ [Occ=Dead] {
+        case w of {
           Nothing -> Roman.foo_$s$wgo m 10#;
           Just n ->
-            case n of _ [Occ=Dead] { GHC.Types.I# x2 ->
-            case GHC.Prim.tagToEnum# @ Bool (GHC.Prim.<=# x2 0#)
-            of _ [Occ=Dead] {
+            case n of { GHC.Types.I# x2 ->
+            case GHC.Prim.tagToEnum# @ Bool (GHC.Prim.<=# x2 0#) of {
               False ->
-                case GHC.Prim.tagToEnum# @ Bool (GHC.Prim.<# x2 100#)
-                of _ [Occ=Dead] {
+                case GHC.Prim.tagToEnum# @ Bool (GHC.Prim.<# x2 100#) of {
                   False ->
-                    case GHC.Prim.tagToEnum# @ Bool (GHC.Prim.<# x2 500#)
-                    of _ [Occ=Dead] {
+                    case GHC.Prim.tagToEnum# @ Bool (GHC.Prim.<# x2 500#) of {
                       False -> Roman.foo_$s$wgo (GHC.Prim.+# m m) (GHC.Prim.-# x2 1#);
                       True -> Roman.foo_$s$wgo m (GHC.Prim.-# x2 3#)
                     };
@@ -167,7 +161,7 @@ foo :: Int -> Int
                  }}]
 foo =
   \ (n :: Int) ->
-    case n of _ [Occ=Dead] { GHC.Types.I# ipv ->
+    case n of { GHC.Types.I# ipv ->
     case Roman.foo_$s$wgo 6# ipv of ww { __DEFAULT -> GHC.Types.I# ww }
     }