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

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