Add Functor and Applicative instances to all Monads

src/ErrMonad.lhs

@@ -18,6 +18,7 @@ module ErrMonad
        , mapErrM	 -- :: (a -> b) -> ErrM a -> ErrM b
        ) where
 
+import Control.Monad (ap)
 \end{code}
 
 \begin{code}
@@ -31,13 +32,12 @@ mapErrM f e =
       Failed    err -> Failed err
       Succeeded v   -> Succeeded (f v)
 
-{- Don't define this as long as there's bound to be 
-   significant pre-Haskell 98 systems out there in
-   circulation.
-
 instance Functor (ErrM a) where
   fmap = mapErrM
--}
+
+instance Applicative (ErrM a) where
+  pure = return
+  (<*>) = ap
 
 instance Monad (ErrM a) where
   (>>=) m f =

src/FillInMonad.lhs

@@ -20,6 +20,7 @@ module FillInMonad
 import qualified ErrMonad as EM
 import DIS  (DISEnv)
 import Target (Target)
+import Control.Monad (ap)
 \end{code}
 
 \begin{code}
@@ -77,11 +78,12 @@ instance Monad FilM where
   (>>=)  = thenFilM
   return = returnFilM
 
-{- Try to do without this one for now - 
-   leads to Haskell compatibility troubles.
+instance Applicative FilM where
+  pure = return
+  (<*>) = ap
+
 instance Functor FilM where
-  map f (FilM act) = FilM (\ env pre tgt m -> do
-			     v <- act env pre tgt m
-			     return (f v))
--}
+  fmap f (FilM act) = FilM (\ env pre tgt m -> do
+        		      v <- act env pre tgt m
+        		      return (f v))
 \end{code}

src/LexM.lhs

@@ -34,6 +34,8 @@ import System.IO.Error ( isEOFError, ioeGetErrorString )
 import qualified Control.Exception  ( catch )
 import Data.List ( isSuffixOf )
 
+import Control.Monad (ap)
+
 -- components threaded by the monad (apart from
 -- the IO token.)
 data LexState
@@ -112,6 +114,15 @@ setLexState lState = LexM (\ (LexState l _ str) -> return ((), LexState l lState
 
 -----
 
+instance Functor LexM where
+  fmap f (LexM m) = LexM $ \st -> do
+    (a, st') <- m st
+    return (f a, st')
+
+instance Applicative LexM where
+  pure = return
+  (<*>) = ap
+
 instance Monad LexM where
   (>>=)  = thenLexM
   return = returnLexM

src/MarshallMonad.lhs

@@ -28,6 +28,7 @@ import Decl ( SrcLoc )
 import DIS  ( DIS )
 import ErrMonad
 import Target (Target)
+import Control.Monad (ap)
 
 \end{code}
 
@@ -67,10 +68,12 @@ mapMarshallM f (MarshallM g) =
 	    Succeeded (v,st') -> 
                 return (f v, st'))
 
-{-
 instance Functor MarshallM where
    fmap = mapMarshallM
--}
+
+instance Applicative MarshallM where
+  pure = return
+  (<*>) = ap
 
 instance Monad MarshallM where
   (MarshallM f) >>= g	= 

src/NameSupply.lhs

@@ -15,6 +15,7 @@ module NameSupply
 	) where
 
 import Name( Name )
+import Control.Monad (ap)
 
 \end{code}
 
@@ -30,11 +31,13 @@ type NameSupply = [Name]
 
 newtype NSM a = NSM (NameSupply -> (a, NameSupply))
 
-{- Try to do without this one for now - Haskell compatibility pitfall.
 instance Functor NSM where
-  map f (NSM g) = NSM (\ns -> let (a, ns') = g ns 
-                              in  (f a, ns'))
--}
+  fmap f (NSM g) = NSM (\ns -> let (a, ns') = g ns 
+                               in  (f a, ns'))
+
+instance Applicative NSM where
+  pure = return
+  (<*>)  = ap
 
 instance Monad NSM where
   (NSM f) >>= g	= 

src/Proc.lhs

@@ -22,6 +22,7 @@ import ListUtils ( insertIfMissing, lowerName, upperName,
 		 )
 import Data.Maybe ( fromMaybe, isJust, fromJust )
 import Data.List  ( unzip4, unzip5 )
+import Control.Monad (ap)
 
 \end{code}
 
@@ -777,6 +778,14 @@ data PM a = PM (PMState -> (PMState, ErrM String a))
 
 type PMState = (String,String) -- current callconv and ext dll. name
 
+instance Functor PM where
+  fmap f (PM m) = PM $ \st ->
+    let (st', a) = m st in (st', mapErrM f a)
+
+instance Applicative PM where
+  pure = return
+  (<*>) = ap
+
 instance Monad PM where
   return v  = PM (\ x -> (x, return v))
   (>>=) (PM m) f =