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

Get rid of `#if CABAL` conditionals again

changelog.md

 # 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

src/Compiler/Hoopl/Fuel.hs

@@ -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

src/Compiler/Hoopl/Graph.hs

@@ -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

src/Compiler/Hoopl/Unique.hs

@@ -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'
 

testing/Ast2ir.hs

 {-# 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')

testing/EvalMonad.hs

 {-# 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 =

testing/OptSupport.hs

@@ -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