X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcHsSyn.lhs;h=e46ab45eb46ddc5b44c8af021f33e6e4a54774d1;hb=88e7faf19b7bcfd8d0d41fa88029c048b615c432;hp=de572ba65bb215fb2370746c11f601f9bc1aae8d;hpb=388e3356f71daffa62f1d4157e1e07e4c68f218a;p=ghc-hetmet.git

diff --git a/compiler/typecheck/TcHsSyn.lhs b/compiler/typecheck/TcHsSyn.lhs
index de572ba..e46ab45 100644
--- a/compiler/typecheck/TcHsSyn.lhs
+++ b/compiler/typecheck/TcHsSyn.lhs
@@ -333,10 +333,10 @@ zonk_bind env bind@(PatBind { pat_lhs = pat, pat_rhs = grhss, pat_rhs_ty = ty})
 	; new_ty    <- zonkTcTypeToType env ty
 	; return (bind { pat_lhs = new_pat, pat_rhs = new_grhss, pat_rhs_ty = new_ty }) }
 
-zonk_bind env (VarBind { var_id = var, var_rhs = expr })
+zonk_bind env (VarBind { var_id = var, var_rhs = expr, var_inline = inl })
   = zonkIdBndr env var 			`thenM` \ new_var ->
     zonkLExpr env expr			`thenM` \ new_expr ->
-    returnM (VarBind { var_id = new_var, var_rhs = new_expr })
+    returnM (VarBind { var_id = new_var, var_rhs = new_expr, var_inline = inl })
 
 zonk_bind env bind@(FunBind { fun_id = var, fun_matches = ms, fun_co_fn = co_fn })
   = wrapLocM (zonkIdBndr env) var	`thenM` \ new_var ->
@@ -363,13 +363,15 @@ zonk_bind env (AbsBinds { abs_tvs = tyvars, abs_dicts = dicts,
     zonkExport env (tyvars, global, local, prags)
 	-- The tyvars are already zonked
 	= zonkIdBndr env global			`thenM` \ new_global ->
-	  mapM zonk_prag prags			`thenM` \ new_prags -> 
+	  zonk_prags prags			`thenM` \ new_prags -> 
 	  returnM (tyvars, new_global, zonkIdOcc env local, new_prags)
-    zonk_prag prag@(L _ (InlinePrag {}))  = return prag
-    zonk_prag (L loc (SpecPrag expr ty inl))
-	= do { expr' <- zonkExpr env expr 
-	     ; ty'   <- zonkTcTypeToType env ty
-	     ; return (L loc (SpecPrag expr' ty' inl)) }
+
+    zonk_prags IsDefaultMethod = return IsDefaultMethod
+    zonk_prags (SpecPrags ps)  = do { ps' <- mapM zonk_prag ps; return (SpecPrags ps') }
+
+    zonk_prag (L loc (SpecPrag co_fn inl))
+	= do { (_, co_fn') <- zonkCoFn env co_fn
+	     ; return (L loc (SpecPrag co_fn' inl)) }
 \end{code}
 
 %************************************************************************
@@ -600,7 +602,6 @@ zonk_cmd_top env (HsCmdTop cmd stack_tys ty ids)
 -------------------------------------------------------------------------
 zonkCoFn :: ZonkEnv -> HsWrapper -> TcM (ZonkEnv, HsWrapper)
 zonkCoFn env WpHole   = return (env, WpHole)
-zonkCoFn env WpInline = return (env, WpInline)
 zonkCoFn env (WpCompose c1 c2) = do { (env1, c1') <- zonkCoFn env c1
 				    ; (env2, c2') <- zonkCoFn env1 c2
 				    ; return (env2, WpCompose c1' c2') }
@@ -682,21 +683,26 @@ zonkStmt env (ParStmt stmts_w_bndrs)
     zonk_branch (stmts, bndrs) = zonkStmts env stmts	`thenM` \ (env1, new_stmts) ->
 				 returnM (new_stmts, zonkIdOccs env1 bndrs)
 
-zonkStmt env (RecStmt segStmts lvs rvs rets binds)
-  = zonkIdBndrs env rvs		`thenM` \ new_rvs ->
-    let
-	env1 = extendZonkEnv env new_rvs
-    in
-    zonkStmts env1 segStmts	`thenM` \ (env2, new_segStmts) ->
+zonkStmt env (RecStmt { recS_stmts = segStmts, recS_later_ids = lvs, recS_rec_ids = rvs
+                      , recS_ret_fn = ret_id, recS_mfix_fn = mfix_id, recS_bind_fn = bind_id
+                      , recS_rec_rets = rets, recS_dicts = binds })
+  = do { new_rvs <- zonkIdBndrs env rvs
+       ; new_lvs <- zonkIdBndrs env lvs
+       ; new_ret_id  <- zonkExpr env ret_id
+       ; new_mfix_id <- zonkExpr env mfix_id
+       ; new_bind_id <- zonkExpr env bind_id
+       ; let env1 = extendZonkEnv env new_rvs
+       ; (env2, new_segStmts) <- zonkStmts env1 segStmts
 	-- Zonk the ret-expressions in an envt that 
 	-- has the polymorphic bindings in the envt
-    mapM (zonkExpr env2) rets	`thenM` \ new_rets ->
-    let
-	new_lvs = zonkIdOccs env2 lvs
-	env3 = extendZonkEnv env new_lvs	-- Only the lvs are needed
-    in
-    zonkRecMonoBinds env3 binds	`thenM` \ (env4, new_binds) ->
-    returnM (env4, RecStmt new_segStmts new_lvs new_rvs new_rets new_binds)
+       ; new_rets <- mapM (zonkExpr env2) rets
+       ; let env3 = extendZonkEnv env new_lvs	-- Only the lvs are needed
+       ; (env4, new_binds) <- zonkRecMonoBinds env3 binds
+       ; return (env4,
+                 RecStmt { recS_stmts = new_segStmts, recS_later_ids = new_lvs
+                         , recS_rec_ids = new_rvs, recS_ret_fn = new_ret_id
+                         , recS_mfix_fn = new_mfix_id, recS_bind_fn = new_bind_id
+                         , recS_rec_rets = new_rets, recS_dicts = new_binds }) }
 
 zonkStmt env (ExprStmt expr then_op ty)
   = zonkLExpr env expr		`thenM` \ new_expr ->