[commit: ghc] wip/T12618: Lint: Complain about saturated uses of the data con worker (a40b103)

[git at git.haskell.org]

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

On branch  : wip/T12618
Link       : http://ghc.haskell.org/trac/ghc/changeset/a40b10315ca752652e23c15be0e7a1d48807f62f/ghc

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

commit a40b10315ca752652e23c15be0e7a1d48807f62f
Author: Joachim Breitner <mail at joachim-breitner.de>
Date:   Tue Oct 4 14:29:17 2016 -0400

    Lint: Complain about saturated uses of the data con worker
    
    to find the spots where ConApp has to be used instead.


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

a40b10315ca752652e23c15be0e7a1d48807f62f
 compiler/coreSyn/CoreLint.hs | 5 +++++
 compiler/coreSyn/MkCore.hs   | 2 +-
 2 files changed, 6 insertions(+), 1 deletion(-)

diff --git a/compiler/coreSyn/CoreLint.hs b/compiler/coreSyn/CoreLint.hs
index 3b1fdf9..920580c 100644
--- a/compiler/coreSyn/CoreLint.hs
+++ b/compiler/coreSyn/CoreLint.hs
@@ -692,6 +692,11 @@ lintCoreExpr e@(App _ _)
                  -> do
               failWithL $ text "Found StaticPtr nested in an expression: " <+>
                           ppr e
+           Var b | Just con <- isDataConWorkId_maybe b
+                 , dataConRepFullArity con <= length args
+                 -> do
+              failWithL $ text "Found saturated use of data con worker (should use ConApp): " <+>
+                          ppr e
            _     -> go
   where
     go = do { fun_ty <- lintCoreExpr fun
diff --git a/compiler/coreSyn/MkCore.hs b/compiler/coreSyn/MkCore.hs
index 79d267d..759ba79 100644
--- a/compiler/coreSyn/MkCore.hs
+++ b/compiler/coreSyn/MkCore.hs
@@ -161,7 +161,7 @@ mkCoreConApps con args
     res_ty = exprType (ConApp con args)
 mkCoreConApps con args
     -- Unsaturated application. TODO #12618 Use wrapper.
-    = WARN ( True, "mkCoreConApps: Unsaturated use." )
+    = WARN ( True, text "mkCoreConApps: Unsaturated use." $$ ppr con <+> ppr args )
       mkCoreApps (Var (dataConWorkId con)) args
 
 mk_val_app :: CoreExpr -> CoreExpr -> Type -> Type -> CoreExpr