From: Manuel M T Chakravarty <chak@cse.unsw.edu.au>
Date: Wed, 20 Sep 2006 17:38:27 +0000 (+0000)
Subject: fixed bug in product unboxing
X-Git-Tag: After_FC_branch_merge~80
X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=5ed1437f5cda8190cc6538284cf0dc761549db8e

fixed bug in product unboxing
Mon Sep 18 14:48:53 EDT 2006  Manuel M T Chakravarty <chak@cse.unsw.edu.au>
  * fixed bug in product unboxing
  Sat Aug  5 21:46:18 EDT 2006  Manuel M T Chakravarty <chak@cse.unsw.edu.au>
    * fixed bug in product unboxing
    Mon Jul 17 09:10:34 EDT 2006  kevind@bu.edu
---

diff --git a/compiler/basicTypes/DataCon.lhs b/compiler/basicTypes/DataCon.lhs
index 486745c..2fc8024 100644
--- a/compiler/basicTypes/DataCon.lhs
+++ b/compiler/basicTypes/DataCon.lhs
@@ -693,6 +693,7 @@ deepSplitProductType_maybe ty
        ; let {result 
              | isNewTyCon tycon && not (isRecursiveTyCon tycon)
              = deepSplitProductType_maybe (newTyConInstRhs tycon tycon_args)
+             | isNewTyCon tycon = Nothing  -- cannot unbox through recursive newtypes
              | otherwise = Just res}
        ; result
        }
diff --git a/compiler/basicTypes/MkId.lhs b/compiler/basicTypes/MkId.lhs
index 47ca1b0..0a1902e 100644
--- a/compiler/basicTypes/MkId.lhs
+++ b/compiler/basicTypes/MkId.lhs
@@ -630,7 +630,7 @@ mkProductBox arg_ids ty
     (tycon, tycon_args, pack_con, con_arg_tys) = splitProductType "mkProductBox" ty
 
     result_expr
-      | isNewTyCon tycon 
+      | isNewTyCon tycon && not (isRecursiveTyCon tycon) 
       = wrap (mkProductBox arg_ids (newTyConInstRhs tycon tycon_args))
       | otherwise = mkConApp pack_con (map Type tycon_args ++ map Var arg_ids)