X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fspecialise%2FSpecConstr.lhs;h=5357a5353958c0b094ca3928e11985082ac2849e;hp=3dfda94ca3bc91fe442458ebaa28b407fb750fe4;hb=703ca1542c8e0983cc9d8eebce6e9f3dd3fd71e2;hpb=120c4c72d6b12e765da9e69612351a53fb7cef4b diff --git a/compiler/specialise/SpecConstr.lhs b/compiler/specialise/SpecConstr.lhs index 3dfda94..5357a53 100644 --- a/compiler/specialise/SpecConstr.lhs +++ b/compiler/specialise/SpecConstr.lhs @@ -27,11 +27,11 @@ import Coercion import Rules import Type hiding( substTy ) import Id +import MkId ( mkImpossibleExpr ) import Var import VarEnv import VarSet import Name -import OccName ( mkSpecOcc ) import DynFlags ( DynFlags(..) ) import StaticFlags ( opt_PprStyle_Debug ) import StaticFlags ( opt_SpecInlineJoinPoints ) @@ -778,7 +778,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