Fix warnings in 16 modules, mostly forward compatibility warnings from GHC 7.8

src/binary/Data/Binary/Builder.hs

@@ -54,7 +54,7 @@ module Data.Binary.Builder (
 
   ) where
 
-import Foreign(Word,Word8,Ptr,Storable,ForeignPtr,withForeignPtr,poke,plusPtr,sizeOf)
+import Foreign(Word8,Ptr,Storable,ForeignPtr,withForeignPtr,poke,plusPtr,sizeOf)
 import System.IO.Unsafe(unsafePerformIO)
 import Data.Monoid
 --import Data.Word

src/binary/Data/Binary/Get.hs

@@ -68,7 +68,7 @@ module Data.Binary.Get (
 
   ) where
 
-import Control.Monad (when,liftM) -- ap
+import Control.Monad (when,liftM, ap)
 import Control.Monad.Fix
 import Data.Maybe (isNothing)
 
@@ -82,9 +82,7 @@ import qualified Data.ByteString.Internal as B
 import qualified Data.ByteString.Lazy.Internal as L
 #endif
 
-#ifdef APPLICATIVE_IN_BASE
 import Control.Applicative (Applicative(..))
-#endif
 
 import Foreign
 
@@ -116,11 +114,9 @@ instance Functor Get where
                             (a, s') -> (f a, s'))
     {-# INLINE fmap #-}
 
-#ifdef APPLICATIVE_IN_BASE
 instance Applicative Get where
     pure  = return
     (<*>) = ap
-#endif
 
 instance Monad Get where
     return a  = Get (\s -> (a, s))
@@ -187,7 +183,7 @@ runGet m str = case unGet m (initState str) of (a, _) -> a
 runGetState :: Get a -> L.ByteString -> Int64 -> (a, L.ByteString, Int64)
 runGetState m str off =
     case unGet m (mkState str off) of
-      (a, ~(S s ss newOff)) -> (a, s `join` ss, newOff)
+      (a, ~(S s ss newOff)) -> (a, s `joinBS` ss, newOff)
 
 ------------------------------------------------------------------------
 
@@ -246,7 +242,7 @@ uncheckedLookAhead n = do
     S s ss _ <- get
     if n <= fromIntegral (B.length s)
         then return (L.fromChunks [B.take (fromIntegral n) s])
-        else return $ L.take n (s `join` ss)
+        else return $ L.take n (s `joinBS` ss)
 
 ------------------------------------------------------------------------
 -- Utility
@@ -286,7 +282,7 @@ getByteString n = readN n id
 getLazyByteString :: Int64 -> Get L.ByteString
 getLazyByteString n = do
     S s ss bytes <- get
-    let big = s `join` ss
+    let big = s `joinBS` ss
     case splitAtST n big of
       (consume, rest) -> do put $ mkState rest (bytes + n)
                             return consume
@@ -297,7 +293,7 @@ getLazyByteString n = do
 getLazyByteStringNul :: Get L.ByteString
 getLazyByteStringNul = do
     S s ss bytes <- get
-    let big = s `join` ss
+    let big = s `joinBS` ss
         (consume, t) = L.break (== 0) big
         (h, rest) = L.splitAt 1 t
     if L.null h
@@ -311,7 +307,7 @@ getLazyByteStringNul = do
 getRemainingLazyByteString :: Get L.ByteString
 getRemainingLazyByteString = do
     S s ss _ <- get
-    return (s `join` ss)
+    return (s `joinBS` ss)
 
 ------------------------------------------------------------------------
 -- Helpers
@@ -325,7 +321,7 @@ getBytes n = do
                 put $! S rest ss (bytes + fromIntegral n)
                 return $! consume
         else
-              case L.splitAt (fromIntegral n) (s `join` ss) of
+              case L.splitAt (fromIntegral n) (s `joinBS` ss) of
                 (consuming, rest) ->
                     do let now = B.concat . L.toChunks $ consuming
                        put $! mkState rest (bytes + fromIntegral n)
@@ -339,19 +335,19 @@ getBytes n = do
 -- ^ important
 
 #ifndef BYTESTRING_IN_BASE
-join :: B.ByteString -> L.ByteString -> L.ByteString
-join bb lb
+joinBS :: B.ByteString -> L.ByteString -> L.ByteString
+joinBS bb lb
     | B.null bb = lb
     | otherwise = L.Chunk bb lb
 
 #else
-join :: B.ByteString -> L.ByteString -> L.ByteString
-join bb (B.LPS lb)
+joinBS :: B.ByteString -> L.ByteString -> L.ByteString
+joinBS bb (B.LPS lb)
     | B.null bb = B.LPS lb
     | otherwise = B.LPS (bb:lb)
 #endif
     -- don't use L.append, it's strict in it's second argument :/
-{- INLINE join -}
+{- INLINE joinBS -}
 
 -- | Split a ByteString. If the first result is consumed before the --
 -- second, this runs in constant heap space.

src/binary/Data/Binary/Put.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE CPP #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      : Data.Binary.Put
@@ -56,10 +55,7 @@ import qualified Data.Binary.Builder as B
 import Data.Word
 import qualified Data.ByteString      as S
 import qualified Data.ByteString.Lazy as L
-
-#ifdef APPLICATIVE_IN_BASE
 import Control.Applicative
-#endif
 
 
 ------------------------------------------------------------------------
@@ -80,14 +76,12 @@ instance Functor PutM where
         fmap f m = Put $ let PairS a w = unPut m in PairS (f a) w
         {-# INLINE fmap #-}
 
-#ifdef APPLICATIVE_IN_BASE
 instance Applicative PutM where
         pure    = return
         m <*> k = Put $
             let PairS f w  = unPut m
                 PairS x w' = unPut k
             in PairS (f x) (w `mappend` w')
-#endif
 
 -- Standard Writer monad, with aggressive inlining
 instance Monad PutM where

src/compiler/GF/Compile.hs

@@ -5,10 +5,10 @@ import GF.Compile.ReadFiles(ModEnv,getOptionsFromFile,getAllFiles,
                             importsOfModule)
 import GF.CompileOne(compileOne)
 
-import GF.Grammar.Grammar(SourceGrammar,msrc,modules,emptySourceGrammar,
-                          abstractOfConcrete,prependModule)
+import GF.Grammar.Grammar(SourceGrammar,emptySourceGrammar,
+                          abstractOfConcrete,prependModule)--,msrc,modules
 
-import GF.Infra.Ident(Ident,identS,showIdent)
+import GF.Infra.Ident(Ident,identS)--,showIdent
 import GF.Infra.Option
 import GF.Infra.UseIO(IOE,FullPath,liftIO,getLibraryDirectory,putIfVerb,
                       justModuleName,extendPathEnv,putStrE,putPointE)
@@ -17,7 +17,7 @@ import GF.Data.Operations(raise,(+++),err)
 import Control.Monad(foldM,when)
 import GF.System.Directory(doesFileExist,getModificationTime)
 import System.FilePath((</>),isRelative,dropFileName)
-import qualified Data.Map as Map(empty,insert,lookup,elems)
+import qualified Data.Map as Map(empty,insert,elems) --lookup
 import Data.List(nub)
 import Data.Time(UTCTime)
 import GF.Text.Pretty(render,($$),(<+>),nest)

src/compiler/GF/Compile/GeneratePMCFG.hs

@@ -36,6 +36,7 @@ import Data.Array.IArray
 import Data.Array.Unboxed
 --import Data.Maybe
 --import Data.Char (isDigit)
+import Control.Applicative(Applicative(..))
 import Control.Monad
 import Control.Monad.Identity
 --import Control.Exception
@@ -247,6 +248,10 @@ newtype CnvMonad a = CM {unCM :: SourceGrammar
                               -> ([ProtoFCat],[Symbol])
                               -> Branch b}
 
+instance Applicative CnvMonad where
+  pure = return
+  (<*>) = ap
+
 instance Monad CnvMonad where
     return a   = CM (\gr c s -> c a s)
     CM m >>= k = CM (\gr c s -> m gr (\a s -> unCM (k a) gr c s) s)

src/compiler/GF/Compile/GetGrammar.hs

@@ -30,7 +30,7 @@ import GF.Compile.ReadFiles(parseSource,lift)
 import qualified Data.ByteString.Char8 as BS
 import Data.Char(isAscii)
 import Control.Monad (foldM,when,unless)
-import System.Cmd (system)
+import System.Process (system)
 import System.Directory(removeFile,getCurrentDirectory)
 import System.FilePath(makeRelative)
 

src/compiler/GF/Compile/TypeCheck/ConcreteNew.hs

@@ -9,6 +9,8 @@ import GF.Compile.TypeCheck.Primitives
 import GF.Infra.CheckM
 --import GF.Infra.UseIO
 import GF.Data.Operations
+import Control.Applicative(Applicative(..))
+import Control.Monad(ap)
 
 import GF.Text.Pretty
 import Data.List (nub, (\\), tails)
@@ -467,6 +469,10 @@ instance Monad TcM where
                                 TcFail    msgs -> TcFail msgs)
   fail     = tcError . pp
 
+instance Applicative TcM where
+  pure = return
+  (<*>) = ap
+
 instance Functor TcM where
   fmap f g = TcM (\ms msgs -> case unTcM g ms msgs of
                            TcOk x ms msgs -> TcOk (f x) ms msgs

src/compiler/GF/Data/BacktrackM.hs

@@ -29,6 +29,7 @@ module GF.Data.BacktrackM (
 		  ) where
 
 import Data.List
+import Control.Applicative
 import Control.Monad
 import Control.Monad.State.Class
 
@@ -60,6 +61,10 @@ foldFinalStates f b (BM m) s = m (\x s b -> f s b) s b
 finalStates :: BacktrackM s () -> s -> [s]
 finalStates bm = map fst . runBM bm
 
+instance Applicative (BacktrackM s) where
+    pure = return
+    (<*>) = ap
+
 instance Monad (BacktrackM s) where
     return a   = BM (\c s b -> c a s b)
     BM m >>= k = BM (\c s b -> m (\a s b -> unBM (k a) c s b) s b)
@@ -69,6 +74,10 @@ instance Monad (BacktrackM s) where
 instance Functor (BacktrackM s) where
     fmap f (BM m) = BM (\c s b -> m (\a s b -> c (f a) s b) s b)
 
+instance Alternative (BacktrackM s) where
+   empty = mzero
+   (<|>) = mplus
+
 instance MonadPlus (BacktrackM s) where
     mzero                 = BM (\c s b -> b)
     (BM f) `mplus` (BM g) = BM (\c s b -> g c s $! f c s b)

src/compiler/GF/Data/ErrM.hs

@@ -14,7 +14,8 @@
 
 module GF.Data.ErrM (Err(..)) where
 
-import Control.Monad (MonadPlus(..))
+import Control.Monad (MonadPlus(..),ap)
+import Control.Applicative
 
 -- | like @Maybe@ type with error msgs
 data Err a = Ok a | Bad String
@@ -31,8 +32,16 @@ instance Functor Err where
   fmap f (Ok a) = Ok (f a)
   fmap f (Bad s) = Bad s
 
+instance Applicative Err where
+  pure = return
+  (<*>) = ap
+
 -- | added by KJ
 instance MonadPlus Err where
     mzero = Bad "error (no reason given)"
     mplus (Ok a)  _ = Ok a
     mplus (Bad s) b = b
+
+instance Alternative Err where
+    empty = mzero
+    (<|>) = mplus

src/compiler/GF/Data/Operations.hs

@@ -67,7 +67,8 @@ import Data.Char (isSpace, toUpper, isSpace, isDigit)
 import Data.List (nub, partition, (\\))
 import qualified Data.Map as Map
 import Data.Map (Map)
-import Control.Monad (liftM,liftM2)
+import Control.Applicative(Applicative(..))
+import Control.Monad (liftM,liftM2,ap)
 
 import GF.Data.ErrM
 import GF.Data.Relation
@@ -330,6 +331,10 @@ stmr f = stm (\s -> return (f s))
 
 instance Functor (STM s) where fmap = liftM
 
+instance Applicative (STM s) where
+  pure = return
+  (<*>) = ap
+
 instance  Monad (STM s) where
   return a    = STM (\s -> return (a,s))
   STM c >>= f = STM (\s -> do 

src/compiler/GF/Grammar/Lexer.x

@@ -6,6 +6,8 @@ module GF.Grammar.Lexer
          , isReservedWord
          ) where
 
+import Control.Applicative
+import Control.Monad(ap)
 import GF.Infra.Ident
 --import GF.Data.Operations
 import qualified Data.ByteString.Char8 as BS
@@ -258,6 +260,13 @@ data ParseResult a
 
 newtype P a = P { unP :: AlexInput -> ParseResult a }
 
+instance Functor P where
+  fmap = (<$>)
+
+instance Applicative P where
+  pure = return
+  (<*>) = ap
+
 instance Monad P where
   return a    = a `seq` (P $ \s -> POk a)
   (P m) >>= k = P $ \ s -> case m s of

src/compiler/GF/Infra/CheckM.hs

@@ -28,7 +28,8 @@ import qualified Data.Map as Map
 import GF.Text.Pretty
 import System.FilePath(makeRelative)
 import Control.Parallel.Strategies(parList,rseq,using)
-import Control.Monad(liftM)
+import Control.Monad(liftM,ap)
+import Control.Applicative(Applicative(..))
 
 type Message = Doc
 type Error   = Message
@@ -50,6 +51,10 @@ instance Monad Check where
                  (ws,Success x) -> unCheck (g x) {-ctxt-} ws
                  (ws,Fail msg)  -> (ws,Fail msg)
 
+instance Applicative Check where
+  pure = return
+  (<*>) = ap
+
 instance ErrorMonad Check where
   raise s = checkError (pp s)
   handle f h = handle' f (h . render)

src/compiler/GF/Infra/SIO.hs

@@ -19,10 +19,11 @@ module GF.Infra.SIO(
        restricted,restrictedSystem
   ) where
 import Prelude hiding (putStrLn,print)
-import Control.Monad(liftM)
+import Control.Applicative(Applicative(..))
+import Control.Monad(liftM,ap)
 import System.IO(hPutStrLn,hFlush,stdout)
 import GF.System.Catch(try)
-import System.Cmd(system)
+import System.Process(system)
 import System.Environment(getEnv)
 import Control.Concurrent.Chan(newChan,writeChan,getChanContents)
 import qualified System.CPUTime as IO(getCPUTime)
@@ -39,6 +40,10 @@ newtype SIO a = SIO {unS::PutStrLn->IO a}
 
 instance Functor SIO where fmap = liftM
 
+instance Applicative SIO where
+  pure = return
+  (<*>) = ap
+
 instance Monad SIO where
   return x = SIO (const (return x))
   SIO m1 >>= xm2 = SIO $ \ h -> m1 h >>= \ x -> unS (xm2 x) h

src/compiler/GF/Infra/UseIO.hs

@@ -31,6 +31,7 @@ import System.Exit
 import System.CPUTime
 --import System.Cmd
 import Text.Printf
+import Control.Applicative(Applicative(..))
 import Control.Monad
 import Control.Monad.Trans(MonadIO(..))
 import Control.Exception(evaluate)
@@ -150,6 +151,10 @@ instance ErrorMonad IOE where
 
 instance Functor IOE where fmap = liftM
 
+instance Applicative IOE where
+  pure = return
+  (<*>) = ap
+
 instance  Monad IOE where
   return a    = ioe (return (return a))
   IOE c >>= f = IOE $ do 

src/compiler/GFC.hs

@@ -2,7 +2,7 @@ module GFC (mainGFC, writePGF) where
 -- module Main where
 
 import PGF
-import PGF.Internal(PGF,concretes,optimizePGF,unionPGF)
+import PGF.Internal(concretes,optimizePGF,unionPGF)
 import PGF.Internal(putSplitAbs,encodeFile,runPut)
 import GF.Compile
 import GF.Compile.Export

src/runtime/haskell/PGF/TypeCheck.hs

@@ -37,6 +37,7 @@ import Data.Map as Map
 import Data.IntMap as IntMap
 import Data.Maybe as Maybe
 import Data.List as List
+import Control.Applicative
 import Control.Monad
 --import Control.Monad.Identity
 import Control.Monad.State
@@ -92,10 +93,18 @@ class Selector s where
   splitSelector :: s -> (s,s)
   select        :: CId -> Scope -> Maybe Int -> TcM s (Expr,TType)
 
+instance Applicative (TcM s) where
+  pure = return
+  (<*>) = ap
+
 instance Monad (TcM s) where
   return x = TcM (\abstr k h -> k x)
   f >>= g  = TcM (\abstr k h -> unTcM f abstr (\x -> unTcM (g x) abstr k h) h)
 
+instance Selector s => Alternative (TcM s) where
+  empty = mzero
+  (<|>) = mplus
+
 instance Selector s => MonadPlus (TcM s) where
   mzero = TcM (\abstr k h ms s -> id)
   mplus f g = TcM (\abstr k h ms s -> let (s1,s2) = splitSelector s