[project @ 2003-02-12 15:01:31 by simonpj]
[ghc-hetmet.git] / ghc / compiler / typecheck / TcHsSyn.lhs
index 88b745d..0ca5d60 100644 (file)
@@ -315,7 +315,20 @@ zonkBinds env (MonoBind bind sigs is_rec)
        zonkMonoBinds env1 bind `thenM` \ (new_bind, new_ids) ->
        returnM (env1, new_bind, new_ids)
     )                          `thenM` \ (env1, new_bind, _) ->
-   returnM (env1, mkMonoBind new_bind [] is_rec)
+   returnM (env1, mkMonoBind is_rec new_bind)
+
+zonkBinds env (IPBinds binds is_with)
+  = mappM zonk_ip_bind binds   `thenM` \ new_binds ->
+    let
+       env1 = extendZonkEnv env (map (ipNameName . fst) new_binds)
+    in
+    returnM (env1, IPBinds new_binds is_with)
+  where
+    zonk_ip_bind (n, e)
+       = mapIPNameTc (zonkIdBndr env) n        `thenM` \ n' ->
+         zonkExpr env e                        `thenM` \ e' ->
+         returnM (n', e')
+
 
 ---------------------------------------------
 zonkMonoBinds :: ZonkEnv -> TcMonoBinds
@@ -454,6 +467,8 @@ zonkExpr env (HsBracketOut body bs)
     zonk_b (n,e) = zonkExpr env e      `thenM` \ e' ->
                   returnM (n,e')
 
+zonkExpr env (HsReify r) = returnM (HsReify r) -- Nothing to zonk; only top
+                                               -- level things can be reified (for now)
 zonkExpr env (HsSplice n e loc) = WARN( True, ppr e )  -- Should not happen
                                  returnM (HsSplice n e loc)
 
@@ -495,19 +510,6 @@ zonkExpr env (HsLet binds expr)
     zonkExpr new_env expr      `thenM` \ new_expr ->
     returnM (HsLet new_binds new_expr)
 
-zonkExpr env (HsWith expr binds is_with)
-  = mappM zonk_ip_bind binds   `thenM` \ new_binds ->
-    let
-       env1 = extendZonkEnv env (map (ipNameName . fst) new_binds)
-    in
-    zonkExpr env1 expr         `thenM` \ new_expr ->
-    returnM (HsWith new_expr new_binds is_with)
-    where
-       zonk_ip_bind (n, e)
-           = mapIPNameTc (zonkIdBndr env) n    `thenM` \ n' ->
-             zonkExpr env e                    `thenM` \ e' ->
-             returnM (n', e')
-
 zonkExpr env (HsDo do_or_lc stmts ids ty src_loc)
   = zonkStmts env stmts        `thenM` \ new_stmts ->
     zonkTcTypeToType env ty    `thenM` \ new_ty   ->