Commit 84255f0f authored by Herbert Valerio Riedel's avatar Herbert Valerio Riedel 🕺

Merge pull request #18 from hvr/pr/de-cpp

Get rid of `#if CABAL` conditionals again
parents d72c5099 8b2e4142
# Changelog for [`hoopl` package](http://hackage.haskell.org/package/hoopl)
## ...
- replace `#if CABAL` macro by no CPP at all
## 3.10.1.1 *Aug 2015*
- Add #if CABAL macro to several hoopl source files such that the Cabal generated macro is not included when building in ghci
......
......@@ -21,14 +21,7 @@ where
import Compiler.Hoopl.Checkpoint
import Compiler.Hoopl.Unique
#if CABAL
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative (Applicative(..))
#endif
#else
import Control.Applicative (Applicative(..))
#endif
import Control.Applicative as AP (Applicative(..))
import Control.Monad (ap,liftM)
class Monad m => FuelMonad m where
......@@ -68,7 +61,7 @@ instance Monad m => Applicative (CheckingFuelMonad m) where
(<*>) = ap
instance Monad m => Monad (CheckingFuelMonad m) where
return = pure
return = AP.pure
fm >>= k = FM (\f -> do { (a, f') <- unFM fm f; unFM (k a) f' })
instance CheckpointMonad m => CheckpointMonad (CheckingFuelMonad m) where
......
......@@ -46,13 +46,7 @@ import Compiler.Hoopl.Collections
import Compiler.Hoopl.Block
import Compiler.Hoopl.Label
#if CABAL
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative (Applicative(..))
#endif
#else
import Control.Applicative (Applicative(..))
#endif
import Control.Applicative as AP (Applicative(..))
import Control.Monad (ap,liftM,liftM2)
-- -----------------------------------------------------------------------------
......@@ -362,7 +356,7 @@ instance Applicative VM where
(<*>) = ap
instance Monad VM where
return = pure
return = AP.pure
m >>= k = VM $ \visited -> let (a, v') = unVM m visited in unVM (k a) v'
marked :: Label -> VM Bool
......
......@@ -24,14 +24,7 @@ import Compiler.Hoopl.Collections
import qualified Data.IntMap as M
import qualified Data.IntSet as S
#ifdef CABAL
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative
#endif
#else
import Control.Applicative
#endif
import Control.Applicative as AP
import Control.Monad (ap,liftM)
-----------------------------------------------------------------------------
......@@ -127,7 +120,7 @@ instance Applicative SimpleUniqueMonad where
(<*>) = ap
instance Monad SimpleUniqueMonad where
return = pure
return = AP.pure
m >>= k = SUM $ \us -> let (a, us') = unSUM m us in
unSUM (k a) us'
......
{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE CPP, RankNTypes, ScopedTypeVariables, GADTs, EmptyDataDecls, PatternGuards, TypeFamilies, NamedFieldPuns #-}
{-# LANGUAGE RankNTypes, ScopedTypeVariables, GADTs, EmptyDataDecls, PatternGuards, TypeFamilies, NamedFieldPuns #-}
module Ast2ir (astToIR, IdLabelMap) where
......@@ -8,13 +8,7 @@ import qualified Compiler.Hoopl as H ((<*>))
import Control.Monad
import qualified Data.Map as M
#if CABAL
#if !MIN_VERSION_base(4,8,0)
import qualified Control.Applicative as AP (Applicative(..))
#endif
#else
import qualified Control.Applicative as AP (Applicative(..))
#endif
import Control.Applicative as AP (Applicative(..))
import qualified Ast as A
import qualified IR as I
......@@ -79,7 +73,7 @@ type IdLabelMap = M.Map String Label
data LabelMapM a = LabelMapM (IdLabelMap -> I.M (IdLabelMap, a))
instance Monad LabelMapM where
return x = LabelMapM (\m -> return (m, x))
return = AP.pure
LabelMapM f1 >>= k = LabelMapM (\m -> do (m', x) <- f1 m
let (LabelMapM f2) = k x
f2 m')
......@@ -87,11 +81,10 @@ instance Monad LabelMapM where
instance Functor LabelMapM where
fmap = liftM
instance AP.Applicative LabelMapM where
pure = return
instance Applicative LabelMapM where
pure x = LabelMapM (\m -> return (m, x))
(<*>) = ap
labelFor l = LabelMapM f
where f m = case M.lookup l m of
Just l' -> return (m, l')
......
{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE CPP, RankNTypes, ScopedTypeVariables, GADTs, EmptyDataDecls, PatternGuards, TypeFamilies, NamedFieldPuns , FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-}
{-# LANGUAGE RankNTypes, ScopedTypeVariables, GADTs, EmptyDataDecls, PatternGuards, TypeFamilies, NamedFieldPuns , FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-}
module EvalMonad (ErrorM, VarEnv, B, State,
EvalM, runProg, inNewFrame, get_proc, get_block,
get_var, set_var, get_heap, set_heap,
Event (..), event) where
import Control.Applicative as AP (Applicative(..))
import Control.Monad.Except
import qualified Data.Map as M
import Prelude hiding (succ)
#if CABAL
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative (Applicative(..))
#endif
#else
import Control.Applicative (Applicative(..))
#endif
import Compiler.Hoopl hiding ((<*>))
import IR
......@@ -27,7 +20,7 @@ type InnerErrorM v = Either (State v, String)
data EvalM v a = EvalM (State v -> InnerErrorM v (State v, a))
instance Monad (EvalM v) where
return x = EvalM (\s -> return (s, x))
return = AP.pure
EvalM f >>= k = EvalM $ \s -> do (s', x) <- f s
let EvalM f' = k x
f' s'
......@@ -36,10 +29,9 @@ instance Functor (EvalM v) where
fmap = liftM
instance Applicative (EvalM v) where
pure = return
pure x = EvalM (\s -> return (s, x))
(<*>) = ap
instance MonadError String (EvalM v) where
throwError e = EvalM (\s -> throwError (s, e))
catchError (EvalM f) handler =
......
......@@ -6,14 +6,7 @@ import Control.Monad
import Data.Maybe
import Prelude hiding (succ)
#if CABAL
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative (Applicative(..))
#endif
#else
import Control.Applicative (Applicative(..))
#endif
import Control.Applicative as AP (Applicative(..))
import Compiler.Hoopl hiding ((<*>))
import IR
......@@ -35,8 +28,10 @@ mapVE _ _ = Nothing
data Mapped a = Old a | New a
instance Monad Mapped where
return = Old
return = AP.pure
Old a >>= k = k a
New a >>= k = asNew (k a)
where asNew (Old a) = New a
......@@ -46,7 +41,7 @@ instance Functor Mapped where
fmap = liftM
instance Applicative Mapped where
pure = return
pure = Old
(<*>) = ap
......
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