- | isSingleton binders || is_simple_lpat pat
- = -- Given p = e, where p binds x,y
- -- we are going to make
- -- v = p (where v is fresh)
- -- x = case v of p -> x
- -- y = case v of p -> x
-
- -- Make up 'v'
- -- NB: give it the type of *pattern* p, not the type of the *rhs* e.
- -- This does not matter after desugaring, but there's a subtle
- -- issue with implicit parameters. Consider
- -- (x,y) = ?i
- -- Then, ?i is given type {?i :: Int}, a PredType, which is opaque
- -- to the desugarer. (Why opaque? Because newtypes have to be. Why
- -- does it get that type? So that when we abstract over it we get the
- -- right top-level type (?i::Int) => ...)
- --
- -- So to get the type of 'v', use the pattern not the rhs. Often more
- -- efficient too.
- newSysLocalDs (hsLPatType pat) `thenDs` \ val_var ->
-
- -- For the error message we make one error-app, to avoid duplication.
- -- But we need it at different types... so we use coerce for that
- mkErrorAppDs iRREFUT_PAT_ERROR_ID
- unitTy (showSDoc (ppr pat)) `thenDs` \ err_expr ->
- newSysLocalDs unitTy `thenDs` \ err_var ->
- mappM (mk_bind val_var err_var) binders `thenDs` \ binds ->
- returnDs ( (val_var, val_expr) :
- (err_var, err_expr) :
- binds )
-
-
- | otherwise
- = mkErrorAppDs iRREFUT_PAT_ERROR_ID
- tuple_ty (showSDoc (ppr pat)) `thenDs` \ error_expr ->
- matchSimply val_expr PatBindRhs pat local_tuple error_expr `thenDs` \ tuple_expr ->
- newSysLocalDs tuple_ty `thenDs` \ tuple_var ->
- let
- mk_tup_bind binder
- = (binder, mkTupleSelector binders binder tuple_var (Var tuple_var))
- in
- returnDs ( (tuple_var, tuple_expr) : map mk_tup_bind binders )
+ | isSingleton binders || is_simple_lpat pat = do
+ -- Given p = e, where p binds x,y
+ -- we are going to make
+ -- v = p (where v is fresh)
+ -- x = case v of p -> x
+ -- y = case v of p -> x
+
+ -- Make up 'v'
+ -- NB: give it the type of *pattern* p, not the type of the *rhs* e.
+ -- This does not matter after desugaring, but there's a subtle
+ -- issue with implicit parameters. Consider
+ -- (x,y) = ?i
+ -- Then, ?i is given type {?i :: Int}, a PredType, which is opaque
+ -- to the desugarer. (Why opaque? Because newtypes have to be. Why
+ -- does it get that type? So that when we abstract over it we get the
+ -- right top-level type (?i::Int) => ...)
+ --
+ -- So to get the type of 'v', use the pattern not the rhs. Often more
+ -- efficient too.
+ val_var <- newSysLocalDs (hsLPatType pat)
+
+ -- For the error message we make one error-app, to avoid duplication.
+ -- But we need it at different types... so we use coerce for that
+ err_expr <- mkErrorAppDs iRREFUT_PAT_ERROR_ID unitTy (showSDoc (ppr pat))
+ err_var <- newSysLocalDs unitTy
+ binds <- mapM (mk_bind val_var err_var) binders
+ return ( (val_var, val_expr) :
+ (err_var, err_expr) :
+ binds )
+
+
+ | otherwise = do
+ error_expr <- mkErrorAppDs iRREFUT_PAT_ERROR_ID tuple_ty (showSDoc (ppr pat))
+ tuple_expr <- matchSimply val_expr PatBindRhs pat local_tuple error_expr
+ tuple_var <- newSysLocalDs tuple_ty
+ let
+ mk_tup_bind binder
+ = (binder, mkTupleSelector binders binder tuple_var (Var tuple_var))
+ return ( (tuple_var, tuple_expr) : map mk_tup_bind binders )