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 (file)
--- 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 (file)
--- 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)