+mkCase, mkCase1, mkCase2
+ :: DynFlags
+ -> OutExpr -> OutId
+ -> [OutAlt] -- Alternatives in standard (increasing) order
+ -> SimplM OutExpr
+
+--------------------------------------------------
+-- 1. Merge Nested Cases
+--------------------------------------------------
+
+mkCase dflags scrut outer_bndr ((DEFAULT, _, deflt_rhs) : outer_alts)
+ | dopt Opt_CaseMerge dflags
+ , Case (Var inner_scrut_var) inner_bndr _ inner_alts <- deflt_rhs
+ , inner_scrut_var == outer_bndr
+ = do { tick (CaseMerge outer_bndr)
+
+ ; let wrap_alt (con, args, rhs) = ASSERT( outer_bndr `notElem` args )
+ (con, args, wrap_rhs rhs)
+ -- Simplifier's no-shadowing invariant should ensure
+ -- that outer_bndr is not shadowed by the inner patterns
+ wrap_rhs rhs = Let (NonRec inner_bndr (Var outer_bndr)) rhs
+ -- The let is OK even for unboxed binders,
+
+ wrapped_alts | isDeadBinder inner_bndr = inner_alts
+ | otherwise = map wrap_alt inner_alts
+
+ merged_alts = mergeAlts outer_alts wrapped_alts
+ -- NB: mergeAlts gives priority to the left
+ -- case x of
+ -- A -> e1
+ -- DEFAULT -> case x of
+ -- A -> e2
+ -- B -> e3
+ -- When we merge, we must ensure that e1 takes
+ -- precedence over e2 as the value for A!
+
+ ; mkCase1 dflags scrut outer_bndr merged_alts
+ }
+ -- Warning: don't call mkCase recursively!
+ -- Firstly, there's no point, because inner alts have already had
+ -- mkCase applied to them, so they won't have a case in their default
+ -- Secondly, if you do, you get an infinite loop, because the bindCaseBndr
+ -- in munge_rhs may put a case into the DEFAULT branch!
+
+mkCase dflags scrut bndr alts = mkCase1 dflags scrut bndr alts
projects / ghc-hetmet.git / blobdiff