diff options
| author | simonpj@microsoft.com <unknown> | 2009-10-30 17:59:07 +0000 |
|---|---|---|
| committer | simonpj@microsoft.com <unknown> | 2009-10-30 17:59:07 +0000 |
| commit | fb6d198f498d4e325a540f28aaa6e1d1530839c3 (patch) | |
| tree | 8c5ddb69e8e7b047e4b09914b1aa8527d121a31e /compiler/deSugar | |
| parent | cf4d037c05371455b7ae68c2b61215bd691e137a (diff) | |
| download | haskell-fb6d198f498d4e325a540f28aaa6e1d1530839c3.tar.gz | |
Minor refactoring
MkCore.mkCoreTupTy moves to TysWiredIn, where it is called mkBoxedTupleTy
Diffstat (limited to 'compiler/deSugar')
| -rw-r--r-- | compiler/deSugar/DsArrows.lhs | 2 | ||||
| -rw-r--r-- | compiler/deSugar/DsExpr.lhs | 6 |
2 files changed, 3 insertions, 5 deletions
diff --git a/compiler/deSugar/DsArrows.lhs b/compiler/deSugar/DsArrows.lhs index 3ffda53c87..48700f6773 100644 --- a/compiler/deSugar/DsArrows.lhs +++ b/compiler/deSugar/DsArrows.lhs @@ -142,7 +142,7 @@ coreCasePair scrut_var var1 var2 body \begin{code} mkCorePairTy :: Type -> Type -> Type -mkCorePairTy t1 t2 = mkCoreTupTy [t1, t2] +mkCorePairTy t1 t2 = mkBoxedTupleTy [t1, t2] mkCorePairExpr :: CoreExpr -> CoreExpr -> CoreExpr mkCorePairExpr e1 e2 = mkCoreTup [e1, e2] diff --git a/compiler/deSugar/DsExpr.lhs b/compiler/deSugar/DsExpr.lhs index 94009fd1fa..11fddf57af 100644 --- a/compiler/deSugar/DsExpr.lhs +++ b/compiler/deSugar/DsExpr.lhs @@ -749,8 +749,7 @@ dsDo stmts body result_ty body = noLoc $ HsDo DoExpr rec_stmts return_app body_ty return_app = nlHsApp (noLoc return_op) (mkLHsTupleExpr rets) body_ty = mkAppTy m_ty tup_ty - tup_ty = mkCoreTupTy (map idType tup_ids) - -- mkCoreTupTy deals with singleton case + tup_ty = mkBoxedTupleTy (map idType tup_ids) -- Deals with singleton case -- In a do expression, pattern-match failure just calls -- the monadic 'fail' rather than throwing an exception @@ -848,8 +847,7 @@ dsMDo tbl stmts body result_ty mfix_pat = noLoc $ LazyPat $ mk_tup_pat rec_tup_pats body = noLoc $ HsDo ctxt rec_stmts return_app body_ty body_ty = mkAppTy m_ty tup_ty - tup_ty = mkCoreTupTy (map idType (later_ids' ++ rec_ids)) - -- mkCoreTupTy deals with singleton case + tup_ty = mkBoxedTupleTy (map idType (later_ids' ++ rec_ids)) -- Deals with singleton case return_app = nlHsApp (nlHsTyApp return_id [tup_ty]) (mkLHsTupleExpr rets) |