Remove some dead code

* The following modules are no longer used and have been removed completely:

	GF.Compile.Compute.ConcreteLazy
	GF.Compile.Compute.ConcreteStrict
	GF.Compile.Refresh

* The STM monad has been commented out. It was only used in
  GF.Compile.SubExpOpt, where could be replaced with a plain State monad,
  since no error handling was needed. One of the functions was hardwired to
  the Err monad, but did in fact not use error handling, so it was turned
  into a pure function.

* The function errVal has been renamed to fromErr (since it is analogous to
  fromMaybe).

* Replaced 'fail' with 'raise' and 'return ()' with 'done' in a few places.

* Some additional old code that was already commented out has been removed.

2 files changed, 46 insertions, 70 deletions

diff --git a/src/compiler/GF/Data/ErrM.hs b/src/compiler/GF/Data/ErrM.hs
index d687a70a5..033c1efac 100644
--- a/src/compiler/GF/Data/ErrM.hs
+++ b/src/compiler/GF/Data/ErrM.hs
@@ -12,15 +12,25 @@
 -- hack for BNFC generated files. AR 21/9/2003
 -----------------------------------------------------------------------------
 
-module GF.Data.ErrM (Err(..)) where
+module GF.Data.ErrM where
 
 import Control.Monad (MonadPlus(..),ap)
 import Control.Applicative
 
--- | like @Maybe@ type with error msgs
+-- | Like 'Maybe' type with error msgs
 data Err a = Ok a | Bad String
   deriving (Read, Show, Eq)
 
+-- | Analogue of 'maybe'
+err :: (String -> b) -> (a -> b) -> Err a -> b 
+err d f e = case e of
+  Ok a -> f a
+  Bad s -> d s
+
+-- | Analogue of 'fromMaybe'
+fromErr :: a -> Err a -> a
+fromErr a = err (const a) id
+
 instance Monad Err where
   return      = Ok
   fail        = Bad
diff --git a/src/compiler/GF/Data/Operations.hs b/src/compiler/GF/Data/Operations.hs
index 69b089623..6d93fec92 100644
--- a/src/compiler/GF/Data/Operations.hs
+++ b/src/compiler/GF/Data/Operations.hs
@@ -18,20 +18,20 @@ module GF.Data.Operations (-- ** Misc functions
 		   ifNull,
 
 		   -- ** The Error monad
-		   Err(..), err, maybeErr, testErr, errVal, errIn, 
+		   Err(..), err, maybeErr, testErr, fromErr, errIn, 
 		   lookupErr,
+
+                   --- ** Monadic operations on lists and pairs
 		   mapPairListM, mapPairsM, pairM,
-		   singleton, --mapsErr, mapsErrTree,
 		   
 		   -- ** Checking
 		   checkUnique, unifyMaybeBy, unifyMaybe,
 
 		   -- ** Binary search trees; now with FiniteMap
-		   BinTree, emptyBinTree, isInBinTree, justLookupTree,
+		   BinTree, emptyBinTree, isInBinTree, --justLookupTree,
 		   lookupTree, --lookupTreeMany,
                    lookupTreeManyAll, updateTree,
 		   buildTree, filterBinTree,
-		   --sorted2tree,
                    mapTree, --mapMTree,
                    tree2list,
  
@@ -43,7 +43,7 @@ module GF.Data.Operations (-- ** Misc functions
 		   numberedParagraphs, prConjList, prIfEmpty, wrapLines,
 
 		   -- ** Extra
-		   combinations,
+		   combinations, done, readIntArg, --singleton,
 
 		   -- ** Topological sorting with test of cyclicity
 		   topoTest, topoTest2,
@@ -52,13 +52,13 @@ module GF.Data.Operations (-- ** Misc functions
 		   iterFix,
 
 		   -- ** Chop into separator-separated parts
-		   chunks, readIntArg, 
-
+		   chunks,
+{-
 		   -- ** State monad with error; from Agda 6\/11\/2001
-		   STM(..), appSTM, stm, stmr, readSTM, updateSTM, writeSTM, done,
-
+		   STM(..), appSTM, stm, stmr, readSTM, updateSTM, writeSTM,
+-}
 		   -- ** Error monad class
-		   ErrorMonad(..), checkAgain, checks, allChecks, doUntil,
+		   ErrorMonad(..), checks, allChecks, doUntil, --checkAgain,
                    liftErr
                 
 		  ) where
@@ -67,8 +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.Applicative(Applicative(..))
-import Control.Monad (liftM,liftM2,ap)
+--import Control.Applicative(Applicative(..))
+import Control.Monad (liftM,liftM2) --,ap
 
 import GF.Data.ErrM
 import GF.Data.Relation
@@ -83,21 +83,12 @@ ifNull b f xs = if null xs then b else f xs
 
 -- the Error monad
 
--- | analogue of @maybe@
-err :: (String -> b) -> (a -> b) -> Err a -> b 
-err d f e = case e of
-  Ok a -> f a
-  Bad s -> d s
-
--- | add msg s to @Maybe@ failures
+-- | Add msg s to 'Maybe' failures
 maybeErr :: ErrorMonad m => String -> Maybe a -> m a
 maybeErr s = maybe (raise s) return
 
 testErr :: ErrorMonad m => Bool -> String -> m ()
-testErr cond msg = if cond then return () else raise msg
-
-errVal :: a -> Err a -> a
-errVal a = err (const a) id
+testErr cond msg = if cond then done else raise msg
 
 errIn :: ErrorMonad m => String -> m a -> m a
 errIn msg m = handle m (\s -> raise (s ++++ "OCCURRED IN" ++++ msg))
@@ -111,12 +102,9 @@ mapPairListM f xys = mapM (\ p@(x,_) -> liftM ((,) x) (f p)) xys
 mapPairsM :: Monad m => (b -> m c) -> [(a,b)] -> m [(a,c)]
 mapPairsM f xys = mapM (\ (x,y) -> liftM ((,) x) (f y)) xys
 
-pairM :: Monad a => (b -> a c) -> (b,b) -> a (c,c)
+pairM :: Monad m => (b -> m c) -> (b,b) -> m (c,c)
 pairM op (t1,t2) = liftM2 (,) (op t1) (op t2)
 
-singleton :: a -> [a]
-singleton = (:[])
-
 -- checking
 
 checkUnique :: (Show a, Eq a) => [a] -> [String]
@@ -144,21 +132,14 @@ emptyBinTree = Map.empty
 
 isInBinTree :: (Ord a) => a -> BinTree a b -> Bool
 isInBinTree = Map.member
-
-justLookupTree :: (Monad m,Ord a) => a -> BinTree a b -> m b
-justLookupTree = lookupTree (const [])
-
-lookupTree :: (Monad m,Ord a) => (a -> String) -> a -> BinTree a b -> m b
-lookupTree pr x tree = case Map.lookup x tree of
-  Just y -> return y
-  _ -> fail ("no occurrence of element" +++ pr x)
 {-
-lookupTreeMany :: Ord a => (a -> String) -> [BinTree a b] -> a -> Err b
-lookupTreeMany pr (t:ts) x = case lookupTree pr x t of
-  Ok v -> return v
-  _ -> lookupTreeMany pr ts x
-lookupTreeMany pr [] x = Bad $ "failed to find" +++ pr x
+justLookupTree :: (ErrorMonad m,Ord a) => a -> BinTree a b -> m b
+justLookupTree = lookupTree (const [])
 -}
+lookupTree :: (ErrorMonad m,Ord a) => (a -> String) -> a -> BinTree a b -> m b
+lookupTree pr x = maybeErr no . Map.lookup x
+  where no = "no occurrence of element" +++ pr x
+
 lookupTreeManyAll :: Ord a => (a -> String) -> [BinTree a b] -> a -> [b]
 lookupTreeManyAll pr (t:ts) x = case lookupTree pr x t of
   Ok v -> v : lookupTreeManyAll pr ts x
@@ -170,16 +151,10 @@ updateTree (a,b) = Map.insert a b
 
 buildTree :: (Ord a) => [(a,b)] -> BinTree a b
 buildTree = Map.fromList
-{-
-sorted2tree :: Ord a => [(a,b)] -> BinTree a b
-sorted2tree = Map.fromAscList
--}
+
 mapTree :: ((a,b) -> c) -> BinTree a b -> BinTree a c
 mapTree f = Map.mapWithKey (\k v -> f (k,v))
-{-
-mapMTree :: (Ord a,Monad m) => ((a,b) -> m c) -> BinTree a b -> m (BinTree a c)
-mapMTree f t = liftM Map.fromList $ sequence [liftM ((,) k) (f (k,x)) | (k,x) <- Map.toList t]
--}
+
 filterBinTree :: Ord a => (a -> b -> Bool) -> BinTree a b -> BinTree a b
 filterBinTree = Map.filterWithKey
 
@@ -269,13 +244,19 @@ wrapLines n s@(c:cs) =
 
 --- optWrapLines = if argFlag "wraplines" True then wrapLines 0 else id
 
--- | 'combinations' is the same as @sequence@!!!
+-- | 'combinations' is the same as 'sequence'!!!
 -- peb 30\/5-04
 combinations :: [[a]] -> [[a]]
 combinations t = case t of 
   []    -> [[]]
   aa:uu -> [a:u | a <- aa, u <- combinations uu]
 
+{-
+-- | 'singleton' is the same as 'return'!!!
+singleton :: a -> [a]
+singleton = (:[])
+-}
+
 -- | topological sorting with test of cyclicity
 topoTest :: Ord a => [(a,[a])] -> Either [a] [[a]]
 topoTest = topologicalSort . mkRel'
@@ -315,7 +296,7 @@ chunks sep ws = case span (/= sep) ws of
 readIntArg :: String -> Int
 readIntArg n = if (not (null n) && all isDigit n) then read n else 0
 
-
+{-
 -- state monad with error; from Agda 6/11/2001
 
 newtype STM s a = STM (s -> Err (a,s)) 
@@ -350,7 +331,7 @@ updateSTM f = stmr (\s -> ((),f s))
 
 writeSTM :: s -> STM s ()
 writeSTM s = stmr (const ((),s))
-
+-}
 done :: Monad m => m ()
 done = return ()
 
@@ -366,28 +347,13 @@ instance ErrorMonad Err where
   handle (Bad i) f  = f i
 
 liftErr e = err raise return e
-
+{-
 instance ErrorMonad (STM s) where
   raise msg = STM (\s -> raise msg)
   handle (STM f) g = STM (\s -> (f s) 
                                 `handle` (\e -> let STM g' = (g e) in
                                                     g' s))
-{-
--- error recovery with multiple reporting AR 30/5/2008
-mapsErr :: (a -> Err b) -> [a] -> Err [b]
-
-mapsErr f = seqs . map f where
-  seqs es = case es of
-    Ok v : ms -> case seqs ms of
-      Ok vs -> return (v : vs)
-      b     -> b
-    Bad s : ms -> case seqs ms of
-      Ok vs  -> Bad s
-      Bad ss -> Bad (s +++++ ss)
-    [] -> return []
-
-mapsErrTree :: (Ord a) => ((a,b) -> Err (a,c)) -> BinTree a b -> Err (BinTree a c)
-mapsErrTree f t =  mapsErr f (tree2list t) >>= return . sorted2tree
+
 -}
 
 -- | if the first check fails try another one