Commit 6c7b41cc authored by Ian Lynagh's avatar Ian Lynagh

Fix the build

Work around various problems caused by some of the monadification patches
not being applied.
parent 80ef1f06
......@@ -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}
......@@ -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}
......
......@@ -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
......
......@@ -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}
%*********************************************************
......
......@@ -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}
......
......@@ -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:
......
......@@ -47,6 +47,7 @@ import UniqSupply
import Outputable
import FastString
import UniqFM
import MonadUtils
\end{code}
-----------------------------------------------------
......
......@@ -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:
......
......@@ -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}
%************************************************************************
%* *
......
module State where
module State (module State, mapAccumLM {- XXX hack -}) where
import MonadUtils
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment