projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Fix desugaring of unboxed tuples
[ghc-hetmet.git]
/
ghc
/
compiler
/
deSugar
/
DsUtils.lhs
diff --git
a/ghc/compiler/deSugar/DsUtils.lhs
b/ghc/compiler/deSugar/DsUtils.lhs
index
70944f8
..
29e7773
100644
(file)
--- a/
ghc/compiler/deSugar/DsUtils.lhs
+++ b/
ghc/compiler/deSugar/DsUtils.lhs
@@
-27,11
+27,11
@@
module DsUtils (
mkSelectorBinds, mkTupleExpr, mkTupleSelector,
mkTupleType, mkTupleCase, mkBigCoreTup,
mkSelectorBinds, mkTupleExpr, mkTupleSelector,
mkTupleType, mkTupleCase, mkBigCoreTup,
- mkCoreTup, mkCoreTupTy,
+ mkCoreTup, mkCoreTupTy, seqVar,
dsSyntaxTable, lookupEvidence,
dsSyntaxTable, lookupEvidence,
- selectSimpleMatchVarL, selectMatchVars
+ selectSimpleMatchVarL, selectMatchVars, selectMatchVar
) where
#include "HsVersions.h"
) where
#include "HsVersions.h"
@@
-169,6
+169,7
@@
selectMatchVars (p:ps) (ty:tys) = do { v <- selectMatchVar p ty
; vs <- selectMatchVars ps tys
; return (v:vs) }
; vs <- selectMatchVars ps tys
; return (v:vs) }
+selectMatchVar (BangPat pat) pat_ty = selectMatchVar (unLoc pat) pat_ty
selectMatchVar (LazyPat pat) pat_ty = selectMatchVar (unLoc pat) pat_ty
selectMatchVar (VarPat var) pat_ty = try_for var pat_ty
selectMatchVar (AsPat var pat) pat_ty = try_for (unLoc var) pat_ty
selectMatchVar (LazyPat pat) pat_ty = selectMatchVar (unLoc pat) pat_ty
selectMatchVar (VarPat var) pat_ty = try_for var pat_ty
selectMatchVar (AsPat var pat) pat_ty = try_for (unLoc var) pat_ty
@@
-255,6
+256,10
@@
wrapBind new old body
| isTyVar new = App (Lam new body) (Type (mkTyVarTy old))
| otherwise = Let (NonRec new (Var old)) body
| isTyVar new = App (Lam new body) (Type (mkTyVarTy old))
| otherwise = Let (NonRec new (Var old)) body
+seqVar :: Var -> CoreExpr -> CoreExpr
+seqVar var body = Case (Var var) var (exprType body)
+ [(DEFAULT, [], body)]
+
mkCoLetMatchResult :: CoreBind -> MatchResult -> MatchResult
mkCoLetMatchResult bind match_result
= adjustMatchResult (mkDsLet bind) match_result
mkCoLetMatchResult :: CoreBind -> MatchResult -> MatchResult
mkCoLetMatchResult bind match_result
= adjustMatchResult (mkDsLet bind) match_result