X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fspecialise%2FSpecConstr.lhs;h=e5583e19dc1181c9e03d46d4bc6521ec473f66f9;hb=2c5337d3f05b1cfb70e2fa63818c453cfc09eb42;hp=78d173140047e3369350d0e540c2e6e3960702e0;hpb=79326edf58637add0e0913189365ccca72c7f82b;p=ghc-hetmet.git diff --git a/compiler/specialise/SpecConstr.lhs b/compiler/specialise/SpecConstr.lhs index 78d1731..e5583e1 100644 --- a/compiler/specialise/SpecConstr.lhs +++ b/compiler/specialise/SpecConstr.lhs @@ -583,10 +583,7 @@ conArgOccs :: ArgOcc -> AltCon -> [ArgOcc] conArgOccs (ScrutOcc fm) (DataAlt dc) | Just pat_arg_occs <- lookupUFM fm dc - = tyvar_unks ++ pat_arg_occs - where - tyvar_unks | isVanillaDataCon dc = [UnkOcc | tv <- dataConUnivTyVars dc] - | otherwise = [] + = [UnkOcc | tv <- dataConUnivTyVars dc] ++ pat_arg_occs conArgOccs other con = repeat UnkOcc \end{code} @@ -878,6 +875,13 @@ argToPat in_scope con_env (Var v) arg_occ then return (True, Var v) else wildCardPat (idType v) +argToPat in_scope con_env (Let _ arg) arg_occ + = argToPat in_scope con_env arg arg_occ + -- Look through let expressions + -- e.g. f (let v = rhs in \y -> ...v...) + -- Here we can specialise for f (\y -> ...) + -- because the rule-matcher will look through the let. + argToPat in_scope con_env arg arg_occ | is_value_lam arg = return (True, arg)