X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FdeSugar%2FDsBinds.lhs;fp=ghc%2Fcompiler%2FdeSugar%2FDsBinds.lhs;h=ff2403e6f4ee63f4832a4f9c55f4a4f237ec81cf;hb=98688c6e8fd33f31c51218cf93cbf03fe3a5e73d;hp=97c844ed456dac8502e4115062ba4f67ba6eb675;hpb=79c93a8a30aaaa6bd940c0677d6f3c57eb727fa2;p=ghc-hetmet.git

diff --git a/ghc/compiler/deSugar/DsBinds.lhs b/ghc/compiler/deSugar/DsBinds.lhs
index 97c844e..ff2403e 100644
--- a/ghc/compiler/deSugar/DsBinds.lhs
+++ b/ghc/compiler/deSugar/DsBinds.lhs
@@ -83,7 +83,7 @@ dsMonoBinds auto_scc (PatMonoBind pat grhss locn) rest
   = putSrcLocDs locn $
     dsGuarded grhss				`thenDs` \ body_expr ->
     mkSelectorBinds pat body_expr		`thenDs` \ sel_binds ->
-    mapDs (addAutoScc auto_scc) sel_binds	`thenDs` \ sel_binds ->
+    mappM (addAutoScc auto_scc) sel_binds	`thenDs` \ sel_binds ->
     returnDs (sel_binds ++ rest)
 
 	-- Common special case: no type or dictionary abstraction
@@ -134,7 +134,7 @@ dsMonoBinds auto_scc (AbsBinds all_tyvars dicts exports inlines binds) rest
     let
 	dict_args = map Var dicts
 
-	mk_bind (tyvars, global, local) n	-- locals !! n == local
+	mk_bind ((tyvars, global, local), n)	-- locals !! n == local
 	  = 	-- Need to make fresh locals to bind in the selector, because
 		-- some of the tyvars will be bound to voidTy
 	    newSysLocalsDs (map substitute local_tys) 	`thenDs` \ locals' ->
@@ -148,7 +148,7 @@ dsMonoBinds auto_scc (AbsBinds all_tyvars dicts exports inlines binds) rest
 	    ty_args    = map mk_ty_arg all_tyvars
 	    substitute = substTyWith all_tyvars ty_args
     in
-    zipWithDs mk_bind exports [0..]		`thenDs` \ export_binds ->
+    mappM mk_bind (exports `zip` [0..])		`thenDs` \ export_binds ->
      -- don't scc (auto-)annotate the tuple itself.
     returnDs ((poly_tup_id, poly_tup_expr) : (export_binds ++ rest))
 \end{code}