+dsBindGroup :: CoreExpr -> HsBindGroup Id -> DsM CoreExpr
+dsBindGroup body (HsIPBinds binds)
+ = foldlDs dsIPBind body binds
+ where
+ dsIPBind body (L _ (IPBind n e))
+ = dsLExpr e `thenDs` \ e' ->
+ returnDs (Let (NonRec (ipNameName n) e') body)
+
+-- Special case for bindings which bind unlifted variables
+-- We need to do a case right away, rather than building
+-- a tuple and doing selections.
+-- Silently ignore INLINE pragmas...
+dsBindGroup body bind@(HsBindGroup hsbinds sigs is_rec)
+ | [L _ (AbsBinds [] [] exports inlines binds)] <- bagToList hsbinds,
+ or [isUnLiftedType (idType g) | (_, g, l) <- exports]
+ = ASSERT (case is_rec of {NonRecursive -> True; other -> False})
+ -- Unlifted bindings are always non-recursive
+ -- and are always a Fun or Pat monobind
+ --
+ -- ToDo: in some bizarre case it's conceivable that there
+ -- could be dict binds in the 'binds'. (See the notes
+ -- below. Then pattern-match would fail. Urk.)
+ let
+ body_w_exports = foldr bind_export body exports
+ bind_export (tvs, g, l) body = ASSERT( null tvs )
+ bindNonRec g (Var l) body
+
+ mk_error_app pat = mkErrorAppDs iRREFUT_PAT_ERROR_ID
+ (exprType body)
+ (showSDoc (ppr pat))
+ in
+ case bagToList binds of
+ [L loc (FunBind (L _ fun) _ matches)]
+ -> putSrcSpanDs loc $
+ matchWrapper (FunRhs (idName fun)) matches `thenDs` \ (args, rhs) ->
+ ASSERT( null args ) -- Functions aren't lifted
+ returnDs (bindNonRec fun rhs body_w_exports)
+
+ [L loc (PatBind pat grhss ty)]
+ -> putSrcSpanDs loc $
+ dsGuarded grhss ty `thenDs` \ rhs ->
+ mk_error_app pat `thenDs` \ error_expr ->
+ matchSimply rhs PatBindRhs pat body_w_exports error_expr
+
+ other -> pprPanic "dsLet: unlifted" (ppr bind $$ ppr body)
+
+-- Ordinary case for bindings
+dsBindGroup body (HsBindGroup binds sigs is_rec)
+ = dsHsNestedBinds binds `thenDs` \ prs ->
+ returnDs (Let (Rec prs) body)
+ -- Use a Rec regardless of is_rec.
+ -- Why? Because it allows the binds to be all
+ -- mixed up, which is what happens in one rare case
+ -- Namely, for an AbsBind with no tyvars and no dicts,
+ -- but which does have dictionary bindings.
+ -- See notes with TcSimplify.inferLoop [NO TYVARS]
+ -- It turned out that wrapping a Rec here was the easiest solution
+ --
+ -- NB The previous case dealt with unlifted bindings, so we
+ -- only have to deal with lifted ones now; so Rec is ok
+\end{code}