X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FdeSugar%2FDsBinds.lhs;h=de8e9818cfe1f4001ff1c12d715d0842ff6b86b4;hb=819d8189dddeb05e881bc641f0a6ab2cd14ee1ad;hp=64306af0e0f30195d4a79ca44b4a37ea1ff38709;hpb=4fbd341bca17fbe4af6dbe23ba414abc45729224;p=ghc-hetmet.git diff --git a/compiler/deSugar/DsBinds.lhs b/compiler/deSugar/DsBinds.lhs index 64306af..de8e981 100644 --- a/compiler/deSugar/DsBinds.lhs +++ b/compiler/deSugar/DsBinds.lhs @@ -236,7 +236,7 @@ dsSpec all_tvs dicts tvs poly_id mono_id mono_bind mb_lhs = decomposeRuleLhs (bndrs ++ const_dicts) body ; case mb_lhs of - Nothing -> do { dsWarn msg; return Nothing } + Nothing -> do { warnDs msg; return Nothing } Just (bndrs', var, args) -> return (Just (addInlineInfo inl spec_id spec_rhs, rule)) where @@ -323,6 +323,7 @@ simpleSubst subst expr = go expr where go (Var v) = lookupVarEnv subst v `orElse` Var v + go (Cast e co) = Cast (go e) co go (Type ty) = Type ty go (Lit lit) = Lit lit go (App fun arg) = App (go fun) (go arg) @@ -421,16 +422,18 @@ addDictScc var rhs = returnDs rhs dsCoercion :: ExprCoFn -> DsM CoreExpr -> DsM CoreExpr dsCoercion CoHole thing_inside = thing_inside dsCoercion (CoCompose c1 c2) thing_inside = dsCoercion c1 (dsCoercion c2 thing_inside) -dsCoercion (CoLams ids c) thing_inside = do { expr <- dsCoercion c thing_inside +dsCoercion (ExprCoFn co) thing_inside = do { expr <- thing_inside + ; return (Cast expr co) } +dsCoercion (CoLams ids) thing_inside = do { expr <- thing_inside ; return (mkLams ids expr) } -dsCoercion (CoTyLams tvs c) thing_inside = do { expr <- dsCoercion c thing_inside +dsCoercion (CoTyLams tvs) thing_inside = do { expr <- thing_inside ; return (mkLams tvs expr) } -dsCoercion (CoApps c ids) thing_inside = do { expr <- dsCoercion c thing_inside +dsCoercion (CoApps ids) thing_inside = do { expr <- thing_inside ; return (mkVarApps expr ids) } -dsCoercion (CoTyApps c tys) thing_inside = do { expr <- dsCoercion c thing_inside +dsCoercion (CoTyApps tys) thing_inside = do { expr <- thing_inside ; return (mkTyApps expr tys) } -dsCoercion (CoLet bs c) thing_inside = do { prs <- dsLHsBinds bs - ; expr <- dsCoercion c thing_inside +dsCoercion (CoLet bs) thing_inside = do { prs <- dsLHsBinds bs + ; expr <- thing_inside ; return (Let (Rec prs) expr) } \end{code}