The Big INLINE Patch: totally reorganise way that INLINE pragmas work

[ghc-hetmet.git] / compiler / typecheck / TcHsSyn.lhs

diff --git a/compiler/typecheck/TcHsSyn.lhs b/compiler/typecheck/TcHsSyn.lhs
index de572ba..ee6de33 100644 (file)
--- 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 ->
@@ -365,11 +365,9 @@ zonk_bind env (AbsBinds { abs_tvs = tyvars, abs_dicts = dicts,
        = zonkIdBndr env global                 `thenM` \ new_global ->
          mapM zonk_prag 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_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 +598,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 +679,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 ->