X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcHsSyn.lhs;h=4f2eda72616979537ccba7e135dcf99249e77d27;hp=5367f8f5b8afc1d60162889f6b8ef085b7ab4c5e;hb=34c8d0312071f7d0f4d221a997d3408c653ef9e5;hpb=5723262f616ac02ddf637f6ff480a599c737ea0d

diff --git a/compiler/typecheck/TcHsSyn.lhs b/compiler/typecheck/TcHsSyn.lhs
index 5367f8f..4f2eda7 100644
--- a/compiler/typecheck/TcHsSyn.lhs
+++ b/compiler/typecheck/TcHsSyn.lhs
@@ -542,6 +542,22 @@ zonkExpr env (HsPar e)
   = zonkLExpr env e	`thenM` \new_e ->
     returnM (HsPar new_e)
 
+zonkExpr env (HsHetMetBrak c e)    
+  = do c' <- zonkTcTypeToType env c
+       e' <- zonkLExpr env e
+       return (HsHetMetBrak c' e')
+
+zonkExpr env (HsHetMetEsc c t e)    
+  = do c' <- zonkTcTypeToType env c
+       t' <- zonkTcTypeToType env t
+       e' <- zonkLExpr env e
+       return (HsHetMetEsc c' t' e')
+
+zonkExpr env (HsHetMetCSP c e)    
+  = do c' <- zonkTcTypeToType env c
+       e' <- zonkLExpr env e
+       return (HsHetMetCSP c' e')
+
 zonkExpr env (SectionL expr op)
   = zonkLExpr env expr	`thenM` \ new_expr ->
     zonkLExpr env op		`thenM` \ new_op ->
@@ -580,8 +596,7 @@ zonkExpr env (HsDo do_or_lc stmts body ty)
   = zonkStmts env stmts 	`thenM` \ (new_env, new_stmts) ->
     zonkLExpr new_env body	`thenM` \ new_body ->
     zonkTcTypeToType env ty	`thenM` \ new_ty   ->
-    zonkDo env do_or_lc	 	`thenM` \ new_do_or_lc ->
-    returnM (HsDo new_do_or_lc new_stmts new_body new_ty)
+    returnM (HsDo do_or_lc new_stmts new_body new_ty)
 
 zonkExpr env (ExplicitList ty exprs)
   = zonkTcTypeToType env ty	`thenM` \ new_ty ->
@@ -689,13 +704,6 @@ zonkCoFn env (WpLet bs)     = do { (env1, bs') <- zonkTcEvBinds env bs
 				 ; return (env1, WpLet bs') }
 
 -------------------------------------------------------------------------
-zonkDo :: ZonkEnv -> HsStmtContext Name -> TcM (HsStmtContext Name)
--- Only used for 'do', so the only Ids are in a MDoExpr table
-zonkDo env (MDoExpr tbl) = do { tbl' <- mapSndM (zonkExpr env) tbl
-                              ; return (MDoExpr tbl') }
-zonkDo _   do_or_lc      = return do_or_lc
-
--------------------------------------------------------------------------
 zonkOverLit :: ZonkEnv -> HsOverLit TcId -> TcM (HsOverLit Id)
 zonkOverLit env lit@(OverLit { ol_witness = e, ol_type = ty })
   = do	{ ty' <- zonkTcTypeToType env ty
@@ -747,7 +755,7 @@ zonkStmt env (ParStmt stmts_w_bndrs)
 
 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 })
+                      , recS_rec_rets = rets })
   = do { new_rvs <- zonkIdBndrs env rvs
        ; new_lvs <- zonkIdBndrs env lvs
        ; new_ret_id  <- zonkExpr env ret_id
@@ -758,13 +766,11 @@ zonkStmt env (RecStmt { recS_stmts = segStmts, recS_later_ids = lvs, recS_rec_id
 	-- Zonk the ret-expressions in an envt that 
 	-- has the polymorphic bindings in the envt
        ; new_rets <- mapM (zonkExpr env2) rets
-       ; let env3 = extendZonkEnv env new_lvs	-- Only the lvs are needed
-       ; (env4, new_binds) <- zonkTcEvBinds env3 binds
-       ; return (env4,
+       ; return (extendZonkEnv env new_lvs,     -- Only the lvs are needed
                  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 }) }
+                         , recS_rec_rets = new_rets }) }
 
 zonkStmt env (ExprStmt expr then_op ty)
   = zonkLExpr env expr		`thenM` \ new_expr ->
@@ -1033,10 +1039,10 @@ zonkEvTerm env (EvCast v co)      = ASSERT( isId v)
                                     do { co' <- zonkTcTypeToType env co
                                        ; return (EvCast (zonkIdOcc env v) co') }
 zonkEvTerm env (EvSuperClass d n) = return (EvSuperClass (zonkIdOcc env d) n)
-zonkEvTerm env (EvDFunApp df tys tms _deps) -- Ignore the dependencies
+zonkEvTerm env (EvDFunApp df tys tms)
   = do { tys' <- zonkTcTypeToTypes env tys
        ; let tms' = map (zonkEvVarOcc env) tms
-       ; return (EvDFunApp (zonkIdOcc env df) tys' tms' _deps) }
+       ; return (EvDFunApp (zonkIdOcc env df) tys' tms') }
 
 zonkTcEvBinds :: ZonkEnv -> TcEvBinds -> TcM (ZonkEnv, TcEvBinds)
 zonkTcEvBinds env (TcEvBinds var) = do { (env', bs') <- zonkEvBindsVar env var
@@ -1085,7 +1091,7 @@ zonkTypeCollecting unbound_tv_set
   = zonkType (mkZonkTcTyVar zonk_unbound_tyvar)
   where
     zonk_unbound_tyvar tv 
-	= do { tv' <- zonkQuantifiedTyVar tv
+        = do { tv' <- zonkQuantifiedTyVar tv
 	     ; tv_set <- readMutVar unbound_tv_set
 	     ; writeMutVar unbound_tv_set (extendVarSet tv_set tv')
 	     ; return (mkTyVarTy tv') }