[commit: ghc] wip/T12618: ConApp bytecode: Add more ASSERT (ef1168b)

[git at git.haskell.org]

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

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

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

commit ef1168ba59c97608f758768cd081c154ed039514
Author: Joachim Breitner <mail at joachim-breitner.de>
Date:   Sun Oct 2 21:19:49 2016 -0400

    ConApp bytecode: Add more ASSERT


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

ef1168ba59c97608f758768cd081c154ed039514
 compiler/ghci/ByteCodeGen.hs | 7 ++++---
 1 file changed, 4 insertions(+), 3 deletions(-)

diff --git a/compiler/ghci/ByteCodeGen.hs b/compiler/ghci/ByteCodeGen.hs
index 9f336c8..214a0f0 100644
--- a/compiler/ghci/ByteCodeGen.hs
+++ b/compiler/ghci/ByteCodeGen.hs
@@ -635,7 +635,7 @@ schemeT :: Word         -- Stack depth
         -> AnnExpr' Id DVarSet
         -> BcM BCInstrList
 
-schemeT d s p (AnnConApp dc args')
+schemeT d s p (AnnConApp dc all_args)
    | isUnboxedTupleCon dc
    = case args of
         [arg2,arg1] | isVAtom arg1 ->
@@ -644,11 +644,12 @@ schemeT d s p (AnnConApp dc args')
                   unboxedTupleReturn d s p arg1
         _other -> multiValException
    | otherwise
-   = do alloc_con <- mkConAppCode d s p dc (reverse args)
+   = do ASSERT( dataConRepFullArity dc == length all_args ) return ()
+        alloc_con <- mkConAppCode d s p dc (reverse args)
         return (alloc_con         `appOL`
                 mkSLIDE 1 (d - s) `snocOL`
                 ENTER)
-  where args = map snd $ dropWhile isAnnTypeArg args'
+  where args = map snd $ dropWhile isAnnTypeArg all_args
 schemeT d s p app
 
 --   | trace ("schemeT: env in = \n" ++ showSDocDebug (ppBCEnv p)) False