[commit: packages/hoopl] master: ghc-7.10 does not like Monad instances that are not Functor and Applicative instances. Made them instances of Functor and Applicative so the build can pass in Travis CI. (814d4ef)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/hoopl

On branch  : master
Link       : http://git.haskell.org/packages/hoopl.git/commitdiff/814d4ef37ef3b5f2dfeddced3875cbd3e8b375b1

>---------------------------------------------------------------

commit 814d4ef37ef3b5f2dfeddced3875cbd3e8b375b1
Author: Ning Wang <email at ningwang.org>
Date:   Tue May 5 19:10:33 2015 -0700

    ghc-7.10 does not like Monad instances that are not Functor and Applicative instances. Made them instances of Functor and Applicative so the build can pass in Travis CI.


>---------------------------------------------------------------

814d4ef37ef3b5f2dfeddced3875cbd3e8b375b1
 testing/Ast2ir.hs     | 20 +++++++++++++++++++-
 testing/EvalMonad.hs  | 19 ++++++++++++++++++-
 testing/OptSupport.hs | 18 +++++++++++++++++-
 3 files changed, 54 insertions(+), 3 deletions(-)

diff --git a/testing/Ast2ir.hs b/testing/Ast2ir.hs
index ff227e8..56f0778 100644
--- a/testing/Ast2ir.hs
+++ b/testing/Ast2ir.hs
@@ -1,11 +1,19 @@
 {-# OPTIONS_GHC -Wall #-}
-{-# LANGUAGE RankNTypes, ScopedTypeVariables, GADTs, EmptyDataDecls, PatternGuards, TypeFamilies, NamedFieldPuns #-}
+{-# LANGUAGE CPP, RankNTypes, ScopedTypeVariables, GADTs, EmptyDataDecls, PatternGuards, TypeFamilies, NamedFieldPuns #-}
 module Ast2ir (astToIR, IdLabelMap) where
 
 import           Compiler.Hoopl
 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 qualified Ast as A
 import qualified IR  as I
 
@@ -67,11 +75,21 @@ toLast (A.Return es)      = return $ I.Return es
 
 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))
   LabelMapM f1 >>= k = LabelMapM (\m -> do (m', x) <- f1 m
                                            let (LabelMapM f2) = k x
                                            f2 m')
+                       
+instance Functor LabelMapM where                       
+  fmap = liftM
+  
+instance AP.Applicative LabelMapM where  
+  pure = return
+  (<*>) = ap
+
+  
 labelFor l = LabelMapM f
   where f m = case M.lookup l m of
                 Just l' -> return (m, l')
diff --git a/testing/EvalMonad.hs b/testing/EvalMonad.hs
index 024d585..628a1f9 100644
--- a/testing/EvalMonad.hs
+++ b/testing/EvalMonad.hs
@@ -1,5 +1,5 @@
 {-# OPTIONS_GHC -Wall #-}
-{-# LANGUAGE RankNTypes, ScopedTypeVariables, GADTs, EmptyDataDecls, PatternGuards, TypeFamilies, NamedFieldPuns , FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-}
+{-# LANGUAGE CPP, RankNTypes, ScopedTypeVariables, GADTs, EmptyDataDecls, PatternGuards, TypeFamilies, NamedFieldPuns , FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-}
 
 module EvalMonad (ErrorM, VarEnv, B, State,
                   EvalM, runProg, inNewFrame, get_proc, get_block,
@@ -10,6 +10,14 @@ import Control.Monad.Error
 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
 import IR
 
@@ -26,6 +34,15 @@ instance Monad (EvalM v) where
   EvalM f >>= k = EvalM $ \s -> do (s', x) <- f s
                                    let EvalM f' = k x
                                    f' s'
+
+instance Functor (EvalM v) where
+  fmap = liftM
+
+instance Applicative (EvalM v) where
+  pure = return
+  (<*>) = ap
+
+
 instance MonadError String (EvalM v) where
   throwError e = EvalM (\s -> throwError (s, e))
   catchError (EvalM f) handler =
diff --git a/testing/OptSupport.hs b/testing/OptSupport.hs
index 11eaa63..dacbcc4 100644
--- a/testing/OptSupport.hs
+++ b/testing/OptSupport.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE GADTs, RankNTypes #-}
+{-# LANGUAGE CPP, GADTs, RankNTypes #-}
 {-# OPTIONS_GHC -Wall -fno-warn-name-shadowing #-}
 module OptSupport (mapVE, mapEE, mapEN, mapVN, fold_EE, fold_EN, insnToG) where
 
@@ -6,6 +6,14 @@ 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 Compiler.Hoopl
 import IR
 
@@ -34,6 +42,14 @@ instance Monad Mapped where
     where asNew (Old a)   = New a
           asNew m@(New _) = m
 
+instance Functor Mapped where
+  fmap = liftM
+  
+instance Applicative Mapped where
+  pure = return
+  (<*>) = ap
+
+
 makeTotal :: (a -> Maybe a) -> (a -> Mapped a)
 makeTotal f a = case f a of Just a' -> New a'
                             Nothing -> Old a