summaryrefslogtreecommitdiff
path: root/compiler/deSugar/DsUtils.lhs
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/deSugar/DsUtils.lhs')
-rw-r--r--compiler/deSugar/DsUtils.lhs20
1 files changed, 9 insertions, 11 deletions
diff --git a/compiler/deSugar/DsUtils.lhs b/compiler/deSugar/DsUtils.lhs
index 3a976878e3..8b5c0a95bd 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)