X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FdeSugar%2FDsUtils.lhs;h=8b5c0a95bd99b040d0f93da1963d6275e36e0d40;hp=3a976878e3ead7625a96703c5621a5ae8bec3f0a;hb=c1c2c25355bc462e521b2c5fb41ac79307da22ff;hpb=f2aaae9757e7532485c97f6c9a9ed5437542d1dd diff --git a/compiler/deSugar/DsUtils.lhs b/compiler/deSugar/DsUtils.lhs index 3a97687..8b5c0a9 100644 --- a/compiler/deSugar/DsUtils.lhs +++ b/compiler/deSugar/DsUtils.lhs @@ -53,7 +53,6 @@ import CoreUtils import MkCore import MkId import Id -import Var import Name import Literal import TyCon @@ -75,7 +74,6 @@ import StaticFlags \end{code} - %************************************************************************ %* * Rebindable syntax @@ -256,10 +254,9 @@ wrapBinds [] e = e wrapBinds ((new,old):prs) e = wrapBind new old (wrapBinds prs e) wrapBind :: Var -> Var -> CoreExpr -> CoreExpr -wrapBind new old body -- Can deal with term variables *or* type variables - | new==old = body - | isTyCoVar new = Let (mkTyBind new (mkTyVarTy old)) body - | otherwise = Let (NonRec new (Var old)) body +wrapBind new old body -- NB: this function must deal with term + | new==old = body -- variables, type variables or coercion variables + | otherwise = Let (NonRec new (varToCoreExpr old)) body seqVar :: Var -> CoreExpr -> CoreExpr seqVar var body = Case (Var var) var (exprType body) @@ -299,10 +296,11 @@ mkCoPrimCaseMatchResult var ty match_alts return (LitAlt lit, [], body) -mkCoAlgCaseMatchResult :: Id -- Scrutinee - -> Type -- Type of exp - -> [(DataCon, [CoreBndr], MatchResult)] -- Alternatives - -> MatchResult +mkCoAlgCaseMatchResult + :: Id -- Scrutinee + -> Type -- Type of exp + -> [(DataCon, [CoreBndr], MatchResult)] -- Alternatives (bndrs *include* tyvars, dicts) + -> MatchResult mkCoAlgCaseMatchResult var ty match_alts | isNewTyCon tycon -- Newtype case; use a let = ASSERT( null (tail match_alts) && null (tail arg_ids1) ) @@ -605,7 +603,7 @@ mkSelectorBinds pat val_expr return (bndr_var, rhs_expr) where error_expr = mkCoerce co (Var err_var) - co = mkUnsafeCoercion (exprType (Var err_var)) (idType bndr_var) + co = mkUnsafeCo (exprType (Var err_var)) (idType bndr_var) is_simple_lpat p = is_simple_pat (unLoc p)