[commit: ghc] wip/T12618: ConApp: More Linting (3f42e87)

[git at git.haskell.org]

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

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

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

commit 3f42e87964b327f4e6b463056727e3de980dfa31
Author: Joachim Breitner <mail at joachim-breitner.de>
Date:   Wed Oct 5 18:13:33 2016 -0400

    ConApp: More Linting


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

3f42e87964b327f4e6b463056727e3de980dfa31
 compiler/coreSyn/CoreLint.hs   | 7 +++++--
 compiler/simplCore/Simplify.hs | 2 +-
 2 files changed, 6 insertions(+), 3 deletions(-)

diff --git a/compiler/coreSyn/CoreLint.hs b/compiler/coreSyn/CoreLint.hs
index 920580c..1c48dcd 100644
--- a/compiler/coreSyn/CoreLint.hs
+++ b/compiler/coreSyn/CoreLint.hs
@@ -695,8 +695,11 @@ lintCoreExpr e@(App _ _)
            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
+              addErrL $ text "Found saturated use of data con worker (should use ConApp): " <+> ppr e
+              go
+           ConApp _ _ -> do
+              addErrL $ text "Found ConApp in argument position. Is that possible?" <+> ppr e $$ ppr args
+              go
            _     -> go
   where
     go = do { fun_ty <- lintCoreExpr fun
diff --git a/compiler/simplCore/Simplify.hs b/compiler/simplCore/Simplify.hs
index a966986..2644cc3 100644
--- a/compiler/simplCore/Simplify.hs
+++ b/compiler/simplCore/Simplify.hs
@@ -473,7 +473,7 @@ prepareRhs top_lvl env0 id rhs0
         = do { (is_exp, env', rhs') <- go n_val_args env rhs
              ; return (is_exp, env', Cast rhs' co) }
     go n_val_args env (ConApp dc args)
-        = ASSERT( n_val_args == 0 )
+        = ASSERT2( n_val_args == 0, ppr (ConApp dc args) <+> ppr n_val_args )
           do { (env', args') <- makeTrivials top_lvl env (getOccFS id) args
              ; return (True, env', ConApp dc args')
              }