summaryrefslogtreecommitdiff
path: root/src/compiler/GF/Data
diff options
context:
space:
mode:
Diffstat (limited to 'src/compiler/GF/Data')
-rw-r--r--src/compiler/GF/Data/BacktrackM.hs9
-rw-r--r--src/compiler/GF/Data/ErrM.hs11
-rw-r--r--src/compiler/GF/Data/Operations.hs7
3 files changed, 25 insertions, 2 deletions
diff --git a/src/compiler/GF/Data/BacktrackM.hs b/src/compiler/GF/Data/BacktrackM.hs
index 4e84022f4..f5ae63997 100644
--- a/src/compiler/GF/Data/BacktrackM.hs
+++ b/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)
diff --git a/src/compiler/GF/Data/ErrM.hs b/src/compiler/GF/Data/ErrM.hs
index e8cea12d4..d687a70a5 100644
--- a/src/compiler/GF/Data/ErrM.hs
+++ 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
diff --git a/src/compiler/GF/Data/Operations.hs b/src/compiler/GF/Data/Operations.hs
index cd42156d4..ef34de27b 100644
--- a/src/compiler/GF/Data/Operations.hs
+++ b/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