From aae28e686a041eb1d1f88a2dd7863216caad68af Mon Sep 17 00:00:00 2001
From: simonmar <unknown>
Date: Mon, 28 Jun 1999 10:04:18 +0000
Subject: [PATCH] [project @ 1999-06-28 10:04:18 by simonmar] Jump to the join
 point when returning a new constructor to a bind default. 
 Fixes:  recent panic in mkStaticAlgReturnCode.

---
 ghc/compiler/codeGen/CgCon.lhs |   49 ++++++++++++++++++++++------------------
 1 file changed, 27 insertions(+), 22 deletions(-)

diff --git a/ghc/compiler/codeGen/CgCon.lhs b/ghc/compiler/codeGen/CgCon.lhs
index 84f6808..5ab41b1 100644
--- a/ghc/compiler/codeGen/CgCon.lhs
+++ b/ghc/compiler/codeGen/CgCon.lhs
@@ -290,7 +290,7 @@ cgReturnDataCon con amodes all_zero_size_args
 
     case sequel of
 
-      CaseAlts _ (Just (alts, Just (Nothing, (_,deflt_lbl))))
+      CaseAlts _ (Just (alts, Just (maybe_deflt, (_,deflt_lbl))))
 	| not (dataConTag con `is_elem` map fst alts)
 	->
 		-- Special case!  We're returning a constructor to the default case
@@ -304,7 +304,9 @@ cgReturnDataCon con amodes all_zero_size_args
 		--	if the default is a non-bind-default (ie does not use y),
 		--	then we should simply jump to the default join point;
 
-		performReturn AbsCNop {- No reg assts -} jump_to_join_point
+		case maybe_deflt of
+		    Nothing -> performReturn AbsCNop {- No reg assts -} jump_to_join_point
+		    Just _  -> build_it_then jump_to_join_point
 	where
 	  is_elem = isIn "cgReturnDataCon"
 	  jump_to_join_point sequel = absC (CJump (CLbl deflt_lbl CodePtrRep))
@@ -372,30 +374,33 @@ cgReturnDataCon con amodes all_zero_size_args
 			False   {-node doesn't point-}
 		
           | otherwise ->
-			-- BUILD THE OBJECT IN THE HEAP
-			-- The first "con" says that the name bound to this
-			-- closure is "con", which is a bit of a fudge, but it only
-			-- affects profiling
-
-			-- This Id is also used to get a unique for a
-			-- temporary variable, if the closure is a CHARLIKE.
-			-- funilly enough, this makes the unique always come
-			-- out as '54' :-)
-		  buildDynCon (mkDataConId con) currentCCS 
-			con amodes all_zero_size_args
-							`thenFC` \ idinfo ->
-		  idInfoToAmode PtrRep idinfo		`thenFC` \ amode ->
-
-
-			-- RETURN
-		  profCtrC SLIT("TICK_RET_NEW") [mkIntCLit (length amodes)] `thenC`
-		  -- could use doTailCall here.
-		  performReturn (move_to_reg amode node) 
-			(mkStaticAlgReturnCode con)
+		build_it_then (mkStaticAlgReturnCode con)
 
   where
     con_name = dataConName con
 
     move_to_reg :: CAddrMode -> MagicId -> AbstractC
     move_to_reg src_amode dest_reg = CAssign (CReg dest_reg) src_amode
+
+    build_it_then return =
+		-- BUILD THE OBJECT IN THE HEAP
+		-- The first "con" says that the name bound to this
+		-- closure is "con", which is a bit of a fudge, but it only
+		-- affects profiling
+
+		-- This Id is also used to get a unique for a
+		-- temporary variable, if the closure is a CHARLIKE.
+		-- funilly enough, this makes the unique always come
+		-- out as '54' :-)
+	  buildDynCon (mkDataConId con) currentCCS 
+		con amodes all_zero_size_args
+						`thenFC` \ idinfo ->
+	  idInfoToAmode PtrRep idinfo		`thenFC` \ amode ->
+
+
+		-- RETURN
+	  profCtrC SLIT("TICK_RET_NEW") [mkIntCLit (length amodes)] `thenC`
+	  -- could use doTailCall here.
+	  performReturn (move_to_reg amode node) return
+
 \end{code}
-- 
1.7.10.4