Fix desugaring of unboxed tuples

[ghc-hetmet.git] / ghc / compiler / deSugar / DsMonad.lhs

diff --git a/ghc/compiler/deSugar/DsMonad.lhs b/ghc/compiler/deSugar/DsMonad.lhs
index 552526b..f24dee4 100644 (file)
--- a/ghc/compiler/deSugar/DsMonad.lhs
+++ b/ghc/compiler/deSugar/DsMonad.lhs
@@ -5,10 +5,11 @@
 
 \begin{code}
 module DsMonad (
-       DsM, mappM,
-       initDs, returnDs, thenDs, listDs, fixDs, mapAndUnzipDs, foldlDs,
+       DsM, mappM, mapAndUnzipM,
+       initDs, returnDs, thenDs, listDs, fixDs, mapAndUnzipDs, 
+       foldlDs, foldrDs,
 
-       newTyVarsDs, 
+       newTyVarsDs, newLocalName,
        duplicateLocalDs, newSysLocalDs, newSysLocalsDs, newUniqueId,
        newFailLocalDs,
        getSrcSpanDs, putSrcSpanDs,
@@ -41,7 +42,6 @@ import HscTypes               ( TyThing(..), TypeEnv, HscEnv,
 import Bag             ( emptyBag, snocBag, Bag )
 import DataCon         ( DataCon )
 import TyCon           ( TyCon )
-import DataCon         ( DataCon )
 import Id              ( mkSysLocal, setIdUnique, Id )
 import Module          ( Module )
 import Var             ( TyVar, setTyVarUnique )
@@ -69,7 +69,7 @@ infixr 9 `thenDs`
 
 \begin{code}
 data DsMatchContext
-  = DsMatchContext (HsMatchContext Name) [Pat Id] SrcSpan
+  = DsMatchContext (HsMatchContext Name) SrcSpan
   | NoMatchContext
   deriving ()
 
@@ -83,7 +83,7 @@ idWrapper e = e
 
 -- The semantics of (match vs (EqnInfo wrap pats rhs)) is the MatchResult
 --     \fail. wrap (case vs of { pats -> rhs fail })
--- where vs are not in the domain of wrap
+-- where vs are not bound by wrap
 
 
 -- A MatchResult is an expression with a hole in it
@@ -120,6 +120,7 @@ thenDs   = thenM
 returnDs = returnM
 listDs   = sequenceM
 foldlDs  = foldlM
+foldrDs  = foldrM
 mapAndUnzipDs = mapAndUnzipM
 
 
@@ -240,8 +241,10 @@ getSrcSpanDs = do { env <- getLclEnv; return (ds_loc env) }
 putSrcSpanDs :: SrcSpan -> DsM a -> DsM a
 putSrcSpanDs new_loc thing_inside = updLclEnv (\ env -> env {ds_loc = new_loc}) thing_inside
 
-dsWarn :: DsWarning -> DsM ()
-dsWarn (loc,warn) = do { env <- getGblEnv; updMutVar (ds_warns env) (`snocBag` (loc,msg)) }
+dsWarn :: SDoc -> DsM ()
+dsWarn warn = do { env <- getGblEnv 
+                ; loc <- getSrcSpanDs
+                ; updMutVar (ds_warns env) (`snocBag` (loc,msg)) }
            where
              msg = ptext SLIT("Warning:") <+> warn
 \end{code}