Fix the build

Work around various problems caused by some of the monadification patches
not being applied.

compiler/basicTypes/UniqSupply.lhs

@@ -20,11 +20,14 @@ module UniqSupply (
 	UniqSM,		-- type: unique supply monad
 	initUs, initUs_,
 	lazyThenUs, lazyMapUs,
-	module MonadUtils, mapAndUnzipM,
+	mapAndUnzipM,
 	MonadUnique(..),
 
 	mkSplitUniqSupply,
-	splitUniqSupply, listSplitUniqSupply
+	splitUniqSupply, listSplitUniqSupply,
+
+    -- Deprecated:
+    getUniqueUs, getUs, returnUs, thenUs, mapUs
   ) where
 
 #include "HsVersions.h"
@@ -32,6 +35,9 @@ module UniqSupply (
 import Unique
 import FastTypes
 
+import MonadUtils
+import Control.Monad
+import Control.Monad.Fix
 #if __GLASGOW_HASKELL__ >= 607
 import GHC.IOBase (unsafeDupableInterleaveIO)
 #else
@@ -112,6 +118,16 @@ instance Monad UniqSM where
   (>>=) = thenUs
   (>>)  = thenUs_
 
+instance Functor UniqSM where
+    fmap f (USM x) = USM (\us -> case x us of
+                                 (r, us') -> (f r, us'))
+
+instance Applicative UniqSM where
+    pure = returnUs
+    (USM f) <*> (USM x) = USM $ \us -> case f us of 
+                            (ff, us')  -> case x us' of 
+                              (xx, us'') -> (ff xx, us'')
+
 -- the initUs function also returns the final UniqSupply; initUs_ drops it
 initUs :: UniqSupply -> UniqSM a -> (a,UniqSupply)
 initUs init_us m = case unUSM m init_us of { (r,us) -> (r,us) }
@@ -176,6 +192,13 @@ getUniqueUs = USM (\us -> case splitUniqSupply us of
 getUniquesUs :: UniqSM [Unique]
 getUniquesUs = USM (\us -> case splitUniqSupply us of
 			      (us1,us2) -> (uniqsFromSupply us1, us2))
+
+mapUs :: (a -> UniqSM b) -> [a] -> UniqSM [b]
+mapUs f []     = returnUs []
+mapUs f (x:xs)
+  = f x         `thenUs` \ r  ->
+    mapUs f xs  `thenUs` \ rs ->
+    returnUs (r:rs)
 \end{code}
 
 \begin{code}
@@ -189,5 +212,4 @@ lazyMapUs f (x:xs)
   = f x             `lazyThenUs` \ r  ->
     lazyMapUs f xs  `lazyThenUs` \ rs ->
     returnUs (r:rs)
-
 \end{code}

compiler/deSugar/DsGRHSs.lhs

@@ -33,8 +33,6 @@ import PrelNames
 import Name
 import SrcLoc
 
-import Control.Monad ((>=>))
-
 \end{code}
 
 @dsGuarded@ is used for both @case@ expressions and pattern bindings.
@@ -142,11 +140,11 @@ isTrueLHsExpr (L _ (HsVar v)) |  v `hasKey` otherwiseIdKey
                                       = Just return
 	-- trueDataConId doesn't have the same unique as trueDataCon
 isTrueLHsExpr (L loc (HsTick    ix frees e))
-    | Just ticks <- isTrueLHsExpr e   = Just (ticks >=> mkTickBox ix frees)
+    | Just ticks <- isTrueLHsExpr e   = Just (\x -> ticks x >>= mkTickBox ix frees)
    -- This encodes that the result is constant True for Hpc tick purposes;
    -- which is specifically what isTrueLHsExpr is trying to find out.
 isTrueLHsExpr (L loc (HsBinTick ixT _ e))
-    | Just ticks <- isTrueLHsExpr e   = Just (ticks >=> mkTickBox ixT [])
+    | Just ticks <- isTrueLHsExpr e   = Just (\x -> ticks x >>= mkTickBox ixT [])
 isTrueLHsExpr (L _ (HsPar e))         = isTrueLHsExpr e
 isTrueLHsExpr other = Nothing
 \end{code}

compiler/ghci/RtClosureInspect.hs

@@ -73,7 +73,7 @@ import Panic
 
 import GHC.Arr          ( Array(..) )
 import GHC.Exts
-import GHC.IOBase
+import GHC.IOBase ( IO(IO) )
 
 import Control.Monad
 import Data.Maybe

compiler/rename/RnEnv.lhs

@@ -70,9 +70,30 @@ import Util
 import Maybes
 import ListSetOps	( removeDups )
 import List		( nubBy )
-import Monad		( when )
 import DynFlags
 import FastString
+import Control.Monad
+\end{code}
+
+\begin{code}
+-- XXX
+thenM :: Monad a => a b -> (b -> a c) -> a c
+thenM = (>>=)
+
+thenM_ :: Monad a => a b -> a c -> a c
+thenM_ = (>>)
+
+returnM :: Monad m => a -> m a
+returnM = return
+
+mappM :: (Monad m) => (a -> m b) -> [a] -> m [b]
+mappM = mapM
+
+mappM_ :: (Monad m) => (a -> m b) -> [a] -> m ()
+mappM_ = mapM_
+
+checkM :: Monad m => Bool -> m () -> m ()
+checkM = unless
 \end{code}
 
 %*********************************************************

compiler/rename/RnExpr.lhs

@@ -64,9 +64,31 @@ import SrcLoc		( Located(..), unLoc, getLoc, noLoc )
 import FastString
 
 import List		( unzip4 )
+import Control.Monad
 \end{code}
 
 
+\begin{code}
+-- XXX
+thenM :: Monad a => a b -> (b -> a c) -> a c
+thenM = (>>=)
+
+thenM_ :: Monad a => a b -> a c -> a c
+thenM_ = (>>)
+
+returnM :: Monad m => a -> m a
+returnM = return
+
+mappM :: (Monad m) => (a -> m b) -> [a] -> m [b]
+mappM = mapM
+
+mappM_ :: (Monad m) => (a -> m b) -> [a] -> m ()
+mappM_ = mapM_
+
+checkM :: Monad m => Bool -> m () -> m ()
+checkM = unless
+\end{code}
+
 %************************************************************************
 %*									*
 \subsubsection{Expressions}

compiler/rename/RnSource.lhs

@@ -59,6 +59,27 @@ import ListSetOps    (findDupsEq, mkLookupFun)
 import Control.Monad
 \end{code}
 
+\begin{code}
+-- XXX
+thenM :: Monad a => a b -> (b -> a c) -> a c
+thenM = (>>=)
+
+thenM_ :: Monad a => a b -> a c -> a c
+thenM_ = (>>)
+
+returnM :: Monad m => a -> m a
+returnM = return
+
+mappM :: (Monad m) => (a -> m b) -> [a] -> m [b]
+mappM = mapM
+
+mappM_ :: (Monad m) => (a -> m b) -> [a] -> m ()
+mappM_ = mapM_
+
+checkM :: Monad m => Bool -> m () -> m ()
+checkM = unless
+\end{code}
+
 @rnSourceDecl@ `renames' declarations.
 It simultaneously performs dependency analysis and precedence parsing.
 It also does the following error checks:

compiler/specialise/SpecConstr.lhs

@@ -47,6 +47,7 @@ import UniqSupply
 import Outputable
 import FastString
 import UniqFM
+import MonadUtils
 \end{code}
 
 -----------------------------------------------------

compiler/stranal/WorkWrap.lhs

@@ -40,6 +40,7 @@ import DynFlags
 import WwLib
 import Util		( lengthIs, notNull )
 import Outputable
+import MonadUtils
 \end{code}
 
 We take Core bindings whose binders have:

compiler/typecheck/TcHsSyn.lhs

@@ -59,6 +59,21 @@ import Bag
 import Outputable
 \end{code}
 
+\begin{code}
+-- XXX
+thenM :: Monad a => a b -> (b -> a c) -> a c
+thenM = (>>=)
+
+thenM_ :: Monad a => a b -> a c -> a c
+thenM_ = (>>)
+
+returnM :: Monad m => a -> m a
+returnM = return
+
+mappM :: (Monad m) => (a -> m b) -> [a] -> m [b]
+mappM = mapM
+\end{code}
+
 
 %************************************************************************
 %*									*

compiler/utils/State.hs

 
-module State where
+module State (module State, mapAccumLM {- XXX hack -}) where
 
 import MonadUtils