import Match ( matchWrapper, matchSimply, matchSinglePat )
import MatchLit ( dsLit, dsOverLit )
-import DsBinds ( dsLHsBinds )
+import DsBinds ( dsLHsBinds, dsCoercion )
import DsGRHSs ( dsGuarded )
import DsListComp ( dsListComp, dsPArrComp )
import DsUtils ( mkErrorAppDs, mkStringExpr, mkConsExpr, mkNilExpr,
#endif
import HsSyn
-import TcHsSyn ( hsPatType )
+import TcHsSyn ( hsPatType, mkVanillaTuplePat )
-- NB: The desugarer, which straddles the source and Core worlds, sometimes
-- needs to see source types (newtypes etc), and sometimes not
(showSDoc (ppr pat))
in
case bagToList binds of
- [L loc (FunBind (L _ fun) _ matches _)]
+ [L loc (FunBind { fun_id = L _ fun, fun_matches = matches, fun_co_fn = co_fn })]
-> putSrcSpanDs loc $
matchWrapper (FunRhs (idName fun)) matches `thenDs` \ (args, rhs) ->
ASSERT( null args ) -- Functions aren't lifted
+ ASSERT( isIdCoercion co_fn )
returnDs (bindNonRec fun rhs body_w_exports)
- [L loc (PatBind pat grhss ty _)]
+ [L loc (PatBind {pat_lhs = pat, pat_rhs = grhss, pat_rhs_ty = ty })]
-> putSrcSpanDs loc $
dsGuarded grhss ty `thenDs` \ rhs ->
mk_error_app pat `thenDs` \ error_expr ->
returnDs (Note (CoreNote $ unpackFS fs) core_expr)
-- Special case to handle unboxed tuple patterns; they can't appear nested
+-- The idea is that
+-- case e of (# p1, p2 #) -> rhs
+-- should desugar to
+-- case e of (# x1, x2 #) -> ... match p1, p2 ...
+-- NOT
+-- let x = e in case x of ....
+--
+-- But there may be a big
+-- let fail = ... in case e of ...
+-- wrapping the whole case, which complicates matters slightly
+-- It all seems a bit fragile. Test is dsrun013.
+
dsExpr (HsCase discrim matches@(MatchGroup _ ty))
| isUnboxedTupleType (funArgTy ty)
= dsLExpr discrim `thenDs` \ core_discrim ->
matchWrapper CaseAlt matches `thenDs` \ ([discrim_var], matching_code) ->
- case matching_code of
- Case (Var x) bndr ty alts | x == discrim_var ->
- returnDs (Case core_discrim bndr ty alts)
- _ -> panic ("dsLExpr: tuple pattern:\n" ++ showSDoc (ppr matching_code))
+ let
+ scrungle (Case (Var x) bndr ty alts)
+ | x == discrim_var = Case core_discrim bndr ty alts
+ scrungle (Let binds body) = Let binds (scrungle body)
+ scrungle other = panic ("dsLExpr: tuple pattern:\n" ++ showSDoc (ppr other))
+ in
+ returnDs (scrungle matching_code)
dsExpr (HsCase discrim matches)
= dsLExpr discrim `thenDs` \ core_discrim ->
dsExpr (DictApp expr dicts) -- becomes a curried application
= dsLExpr expr `thenDs` \ core_expr ->
returnDs (foldl (\f d -> f `App` (Var d)) core_expr dicts)
+
+dsExpr (HsCoerce co_fn e) = dsCoercion co_fn (dsExpr e)
\end{code}
Here is where we desugar the Template Haskell brackets and escapes
mk_tup_pat :: [LPat Id] -> LPat Id
mk_tup_pat [p] = p
- mk_tup_pat ps = noLoc $ TuplePat ps Boxed
+ mk_tup_pat ps = noLoc $ mkVanillaTuplePat ps Boxed
mk_ret_tup :: [LHsExpr Id] -> LHsExpr Id
mk_ret_tup [r] = r