[commit: ghc] : Handle nullary constructors in the byte code generator. (2fee127)

[git at git.haskell.org]

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

On branch  : 
Link       : http://ghc.haskell.org/trac/ghc/changeset/2fee1279c78e39e7233a9f79b27549b02a74d565/ghc

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

commit 2fee1279c78e39e7233a9f79b27549b02a74d565
Author: Joachim Breitner <mail at joachim-breitner.de>
Date:   Sun Oct 9 13:20:59 2016 -0400

    Handle nullary constructors in the byte code generator.


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

2fee1279c78e39e7233a9f79b27549b02a74d565
 compiler/ghci/ByteCodeGen.hs | 17 +++++++++++++++--
 1 file changed, 15 insertions(+), 2 deletions(-)

diff --git a/compiler/ghci/ByteCodeGen.hs b/compiler/ghci/ByteCodeGen.hs
index 214a0f0..2f9c938 100644
--- a/compiler/ghci/ByteCodeGen.hs
+++ b/compiler/ghci/ByteCodeGen.hs
@@ -446,7 +446,8 @@ schemeE d s p (AnnLet (AnnNonRec x (_,AnnConApp dc args)) (_,body))
    = do -- Special case for a non-recursive let whose RHS is a
         -- saturatred constructor application.
         -- Just allocate the constructor and carry on
-        alloc_code <- mkConAppCode d s p dc (map snd (reverse args))
+        let args_r_to_l = reverse $ map snd $ dropWhile isAnnTypeArg args
+        alloc_code <- mkConAppCode d s p dc args_r_to_l
         body_code <- schemeE (d+1) s (Map.insert x d p) body
         return (alloc_code `appOL` body_code)
 
@@ -720,7 +721,7 @@ mkConAppCode _ _ _ con []       -- Nullary constructor
         -- copy of this constructor, use the single shared version.
 
 mkConAppCode orig_d _ p con args_r_to_l
-  = ASSERT( dataConRepArity con == length args_r_to_l )
+  = ASSERT2( dataConRepArity con == length args_r_to_l, ppr con <+> ppr (length args_r_to_l) )
     do_pushery orig_d (non_ptr_args ++ ptr_args)
  where
         -- The args are already in reverse order, which is the way PACK
@@ -1387,6 +1388,16 @@ pushAtom d p (AnnVar v)
         MASSERT(sz == 1)
         return (unitOL (PUSH_G (getName v)), sz)
 
+pushAtom _ _ (AnnConApp dc args) = do
+    MASSERT( all isAnnTypeArg args )
+    dflags <- getDynFlags
+    let v = dataConWorkId dc
+    let sz :: Word16
+        sz = fromIntegral (idSizeW dflags v)
+    MASSERT(sz == 1)
+    return (unitOL (PUSH_G (getName v)), sz)
+
+
 
 pushAtom _ _ (AnnLit lit) = do
      dflags <- getDynFlags
@@ -1648,6 +1659,8 @@ isVAtom _                     = False
 atomPrimRep :: AnnExpr' Id ann -> PrimRep
 atomPrimRep e | Just e' <- bcView e = atomPrimRep e'
 atomPrimRep (AnnVar v)              = bcIdPrimRep v
+atomPrimRep (AnnConApp dc args)     = ASSERT (all isAnnTypeArg args)
+                                      bcIdPrimRep (dataConWorkId dc)
 atomPrimRep (AnnLit l)              = typePrimRep (literalType l)
 
 -- Trac #12128: