Commit e55df039 authored by sewardj's avatar sewardj
Browse files

[project @ 2001-10-11 14:31:45 by sewardj]

Correctly handle unboxed tuples when converting DEFAULT alts to
  unboxed tuple constructors in case args.  (I'm sure this could
  be worded better).  Branch and HEAD have drifted too far apart
  for easy common commit for this, so is committed seperately for
  ghc-5-02-branch.
parent 6baa39f9
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
% $Id: CgCase.lhs,v 1.53 2001/09/26 15:11:50 simonpj Exp $
% $Id: CgCase.lhs,v 1.54 2001/10/11 14:31:45 sewardj Exp $
%
%********************************************************
%* *
......@@ -396,17 +396,22 @@ cgEvalAlts cc_slot bndr srt alts
Just spec_tycon = maybe_tycon
in
-- deal with the unboxed tuple case
-- Deal with the unboxed tuple case
if is_alg && isUnboxedTupleTyCon spec_tycon then
case alts of
[alt] -> let lbl = mkReturnInfoLabel uniq in
cgUnboxedTupleAlt uniq cc_slot True alt
`thenFC` \ abs_c ->
getSRTInfo srt `thenFC` \ srt_info ->
absC (CRetDirect uniq abs_c srt_info
liveness_mask) `thenC`
returnFC (CaseAlts (CLbl lbl RetRep) Nothing)
_ -> panic "cgEvalAlts: dodgy case of unboxed tuple type"
-- By now, the simplifier should have have turned it
-- into case e of (# a,b #) -> e
-- There shouldn't be a
-- case e of DEFAULT -> e
ASSERT2( case (alts, deflt) of { ([_],StgNoDefault) -> True; other -> False },
text "cgEvalAlts: dodgy case of unboxed tuple type" )
let
alt = head alts
lbl = mkReturnInfoLabel uniq
in
cgUnboxedTupleAlt uniq cc_slot True alt `thenFC` \ abs_c ->
getSRTInfo srt `thenFC` \ srt_info ->
absC (CRetDirect uniq abs_c srt_info liveness_mask) `thenC`
returnFC (CaseAlts (CLbl lbl RetRep) Nothing)
-- normal algebraic (or polymorphic) case alternatives
else let
......
......@@ -41,7 +41,7 @@ import Type ( Type, seqType,
splitRepFunTys, isStrictType
)
import OccName ( UserFS )
import TyCon ( tyConDataConsIfAvailable, isDataTyCon )
import TyCon ( tyConDataConsIfAvailable, isAlgTyCon, isNewTyCon )
import DataCon ( dataConRepArity, dataConSig, dataConArgTys )
import Var ( mkSysTyVar, tyVarKind )
import Util ( lengthExceeds, mapAccumL )
......@@ -886,12 +886,14 @@ mkAlts scrut case_bndr alts@((con1,bndrs1,rhs1) : con_alts)
mkAlts scrut case_bndr alts
| Just (tycon, inst_tys) <- splitTyConApp_maybe (idType case_bndr),
isDataTyCon tycon, -- It's a data type
isAlgTyCon tycon, -- It's a data type, tuple, or unboxed tuples.
-- We aren't expecting any newtypes at this point.
(alts_no_deflt, Just rhs) <- findDefault alts,
-- There is a DEFAULT case
[missing_con] <- filter is_missing (tyConDataConsIfAvailable tycon)
-- There is just one missing constructor!
= tick (FillInCaseDefault case_bndr) `thenSmpl_`
= ASSERT( not (isNewTyCon tycon) )
tick (FillInCaseDefault case_bndr) `thenSmpl_`
getUniquesSmpl `thenSmpl` \ tv_uniqs ->
getUniquesSmpl `thenSmpl` \ id_uniqs ->
let
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment