From: simonpj <unknown>
Date: Fri, 30 Nov 2001 09:39:32 +0000 (+0000)
Subject: [project @ 2001-11-30 09:39:32 by simonpj]
X-Git-Tag: Approximately_9120_patches~485
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=393db8af18d729428232222efe6856dfc42380d3;p=ghc-hetmet.git

[project @ 2001-11-30 09:39:32 by simonpj]
Print a bit more info if dsExpr fails for unlifted bindings
---

diff --git a/ghc/compiler/deSugar/DsExpr.lhs b/ghc/compiler/deSugar/DsExpr.lhs
index 6d8df65..162ae24 100644
--- a/ghc/compiler/deSugar/DsExpr.lhs
+++ b/ghc/compiler/deSugar/DsExpr.lhs
@@ -88,7 +88,7 @@ dsLet (ThenBinds b1 b2) body
 -- We need to do a case right away, rather than building
 -- a tuple and doing selections.
 -- Silently ignore INLINE pragmas...
-dsLet (MonoBind (AbsBinds [] [] exports inlines binds) sigs is_rec) body
+dsLet bind@(MonoBind (AbsBinds [] [] exports inlines binds) sigs is_rec) body
   | or [isUnLiftedType (idType g) | (_, g, l) <- exports]
   = ASSERT (case is_rec of {NonRecursive -> True; other -> False})
 	-- Unlifted bindings are always non-recursive
@@ -109,6 +109,8 @@ dsLet (MonoBind (AbsBinds [] [] exports inlines binds) sigs is_rec) body
 	   dsGuarded grhss 			`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)
   where
     body_w_exports		 = foldr bind_export body exports
     bind_export (tvs, g, l) body = ASSERT( null tvs )