summaryrefslogtreecommitdiff
path: root/compiler/iface/TcIface.lhs
diff options
context:
space:
mode:
authorsimonpj@microsoft.com <unknown>2010-10-27 18:42:35 +0000
committersimonpj@microsoft.com <unknown>2010-10-27 18:42:35 +0000
commit6104e5ebb5050003d39d0485015595759d15ebf8 (patch)
treee4ff8fa540d213a446a43cda04394c55a91b3c67 /compiler/iface/TcIface.lhs
parent42fe164955f3c326604e284505b271c6035d0245 (diff)
downloadhaskell-6104e5ebb5050003d39d0485015595759d15ebf8.tar.gz
Buglet in tcIface, now that nested binders can have pragmas
This fix ties the knot for recursive groups properly
Diffstat (limited to 'compiler/iface/TcIface.lhs')
-rw-r--r--compiler/iface/TcIface.lhs50
1 files changed, 26 insertions, 24 deletions
diff --git a/compiler/iface/TcIface.lhs b/compiler/iface/TcIface.lhs
index c39b713f9f..431b3a72f1 100644
--- a/compiler/iface/TcIface.lhs
+++ b/compiler/iface/TcIface.lhs
@@ -871,20 +871,32 @@ tcIfaceExpr (IfaceCase scrut case_bndr ty alts) = do
ty' <- tcIfaceType ty
return (Case scrut' case_bndr' ty' alts')
-tcIfaceExpr (IfaceLet (IfaceNonRec bndr rhs) body) = do
- rhs' <- tcIfaceExpr rhs
- id <- tcIfaceLetBndr bndr
- body' <- extendIfaceIdEnv [id] (tcIfaceExpr body)
- return (Let (NonRec id rhs') body')
-
-tcIfaceExpr (IfaceLet (IfaceRec pairs) body) = do
- ids <- mapM tcIfaceLetBndr bndrs
- extendIfaceIdEnv ids $ do
- rhss' <- mapM tcIfaceExpr rhss
- body' <- tcIfaceExpr body
- return (Let (Rec (ids `zip` rhss')) body')
- where
- (bndrs, rhss) = unzip pairs
+tcIfaceExpr (IfaceLet (IfaceNonRec (IfLetBndr fs ty info) rhs) body)
+ = do { name <- newIfaceName (mkVarOccFS fs)
+ ; ty' <- tcIfaceType ty
+ ; id_info <- tcIdInfo False {- Don't ignore prags; we are inside one! -}
+ name ty' info
+ ; let id = mkLocalIdWithInfo name ty' id_info
+ ; rhs' <- tcIfaceExpr rhs
+ ; body' <- extendIfaceIdEnv [id] (tcIfaceExpr body)
+ ; return (Let (NonRec id rhs') body') }
+
+tcIfaceExpr (IfaceLet (IfaceRec pairs) body)
+ = do { ids <- mapM tc_rec_bndr (map fst pairs)
+ ; extendIfaceIdEnv ids $ do
+ { pairs' <- zipWithM tc_pair pairs ids
+ ; body' <- tcIfaceExpr body
+ ; return (Let (Rec pairs') body') } }
+ where
+ tc_rec_bndr (IfLetBndr fs ty _)
+ = do { name <- newIfaceName (mkVarOccFS fs)
+ ; ty' <- tcIfaceType ty
+ ; return (mkLocalId name ty') }
+ tc_pair (IfLetBndr _ _ info, rhs) id
+ = do { rhs' <- tcIfaceExpr rhs
+ ; id_info <- tcIdInfo False {- Don't ignore prags; we are inside one! -}
+ (idName id) (idType id) info
+ ; return (setIdInfo id id_info, rhs') }
tcIfaceExpr (IfaceCast expr co) = do
expr' <- tcIfaceExpr expr
@@ -1236,16 +1248,6 @@ bindIfaceBndrs (b:bs) thing_inside
bindIfaceBndrs bs $ \ bs' ->
thing_inside (b':bs')
-
------------------------
-tcIfaceLetBndr :: IfaceLetBndr -> IfL Id
-tcIfaceLetBndr (IfLetBndr fs ty info)
- = do { name <- newIfaceName (mkVarOccFS fs)
- ; ty' <- tcIfaceType ty
- ; id_info <- tcIdInfo False {- Don't ignore prags; we are inside one! -}
- name ty' info
- ; return (mkLocalIdWithInfo name ty' id_info) }
-
-----------------------
newExtCoreBndr :: IfaceLetBndr -> IfL Id
newExtCoreBndr (IfLetBndr var ty _) -- Ignoring IdInfo for now