X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fspecialise%2FSpecConstr.lhs;h=3a4b38291081acd41bb148564d7b5a74debb31ab;hp=3dfda94ca3bc91fe442458ebaa28b407fb750fe4;hb=9414bda057e8ac8422ca5590c8500c7cdee323bb;hpb=a11662957fa688997e6c4befff44e7efe94c2db8

diff --git a/compiler/specialise/SpecConstr.lhs b/compiler/specialise/SpecConstr.lhs
index 3dfda94..3a4b382 100644
--- a/compiler/specialise/SpecConstr.lhs
+++ b/compiler/specialise/SpecConstr.lhs
@@ -27,6 +27,7 @@ import Coercion
 import Rules
 import Type		hiding( substTy )
 import Id
+import MkId		( mkImpossibleExpr )
 import Var
 import VarEnv
 import VarSet
@@ -778,7 +779,8 @@ scExpr' env (Case scrut b ty alts)
   where
     sc_con_app con args scrut' 	-- Known constructor; simplify
 	= do { let (_, bs, rhs) = findAlt con alts
-		   alt_env' = extendScSubstList env ((b,scrut') : bs `zip` trimConArgs con args)
+	       	   	          `orElse` (DEFAULT, [], mkImpossibleExpr (coreAltsType alts))
+		   alt_env'  = extendScSubstList env ((b,scrut') : bs `zip` trimConArgs con args)
 	     ; scExpr alt_env' rhs }
 				
     sc_vanilla scrut_usg scrut'	-- Normal case