Reduced clutter in monadic code

+ Eliminated vairous ad-hoc coersion functions between specific monads 
  (IO, Err, IOE, Check) in favor of more general lifting functions
  (liftIO, liftErr).
+ Generalized many basic monadic operations from specific monads to
  arbitrary monads in the appropriate class (MonadIO and/or ErrorMonad),
  thereby completely eliminating the need for lifting functions in lots
  of places.

This can be considered a small step forward towards a cleaner
compiler API and more malleable compiler code in general.

7 files changed, 62 insertions, 66 deletions

diff --git a/src/compiler/GF/Compile/CheckGrammar.hs b/src/compiler/GF/Compile/CheckGrammar.hs
index 967925275..568686f92 100644
--- a/src/compiler/GF/Compile/CheckGrammar.hs
+++ b/src/compiler/GF/Compile/CheckGrammar.hs
@@ -50,10 +50,10 @@ checkModule opts sgr mo@(m,mi) = do
   checkRestrictedInheritance sgr mo
   mo <- case mtype mi of
           MTConcrete a -> do let gr = prependModule sgr mo
-                             abs <- checkErr $ lookupModule gr a
+                             abs <- lookupModule gr a
                              checkCompleteGrammar opts gr (a,abs) mo
           _            -> return mo
-  infoss <- checkErr $ topoSortJments2 mo
+  infoss <- topoSortJments2 mo
   foldM updateCheckInfos mo infoss
   where
     updateCheckInfos mo = fmap (foldl update mo) . parallelCheck . map check
@@ -246,7 +246,7 @@ checkInfo opts sgr (m,mo) c info = do
 
     ResOverload os tysts -> chIn NoLoc "overloading" $ do
       tysts' <- mapM (uncurry $ flip (\(L loc1 t) (L loc2 ty) -> checkLType gr [] t ty >>= \(t,ty) -> return (L loc1 t, L loc2 ty))) tysts  -- return explicit ones
-      tysts0 <- checkErr $ lookupOverload gr (m,c)  -- check against inherited ones too
+      tysts0 <- lookupOverload gr (m,c)  -- check against inherited ones too
       tysts1 <- mapM (uncurry $ flip (checkLType gr [])) 
                   [(mkFunType args val,tr) | (args,(val,tr)) <- tysts0]
       --- this can only be a partial guarantee, since matching
@@ -267,7 +267,7 @@ checkInfo opts sgr (m,mo) c info = do
                            nest 2 (text "Happened in" <+> text cat <+> ppIdent c))
 
    mkPar (f,co) = do
-       vs <- checkErr $ liftM combinations $ mapM (\(_,_,ty) -> allParamValues gr ty) co
+       vs <- liftM combinations $ mapM (\(_,_,ty) -> allParamValues gr ty) co
        return $ map (mkApp (QC (m,f))) vs
 
    checkUniq xss = case xss of
@@ -317,13 +317,13 @@ linTypeOfType cnc m typ = do
      let vars = mkRecType varLabel $ replicate n typeStr
 	 symb = argIdent n cat i
      rec <- if n==0 then return val else
-            checkErr $ errIn (render (text "extending" $$
+                       errIn (render (text "extending" $$
                                       nest 2 (ppTerm Unqualified 0 vars) $$
                                       text "with" $$
                                       nest 2 (ppTerm Unqualified 0 val))) $
                              plusRecType vars val
      return (Explicit,symb,rec)
    lookLin (_,c) = checks [ --- rather: update with defLinType ?
-      checkErr (lookupLincat cnc m c) >>= computeLType cnc []
+      lookupLincat cnc m c >>= computeLType cnc []
      ,return defLinType
      ]
diff --git a/src/compiler/GF/Compile/GeneratePMCFG.hs b/src/compiler/GF/Compile/GeneratePMCFG.hs
index 457853150..059038b6c 100644
--- a/src/compiler/GF/Compile/GeneratePMCFG.hs
+++ b/src/compiler/GF/Compile/GeneratePMCFG.hs
@@ -23,10 +23,9 @@ import GF.Grammar.Predef
 import GF.Grammar.Lockfield (isLockLabel)
 import GF.Data.BacktrackM
 import GF.Data.Operations
-import GF.Infra.UseIO (IOE)
+import GF.Infra.UseIO (IOE,ePutStr,ePutStrLn)
 import GF.Data.Utilities (updateNthM) --updateNth
 import GF.Compile.Compute.ConcreteNew(GlobalEnv,normalForm,resourceValues,ppL)
-import System.IO(hPutStr,hPutStrLn,stderr)
 import qualified Data.Map as Map
 import qualified Data.Set as Set
 import qualified Data.List as List
@@ -39,7 +38,6 @@ import Data.Array.Unboxed
 --import Data.Char (isDigit)
 import Control.Monad
 import Control.Monad.Identity
-import Control.Monad.Trans (liftIO)
 --import Control.Exception
 
 ----------------------------------------------------------------------
@@ -48,7 +46,7 @@ import Control.Monad.Trans (liftIO)
 generatePMCFG :: Options -> SourceGrammar -> Maybe FilePath -> SourceModule -> IOE SourceModule
 generatePMCFG opts sgr opath cmo@(cm,cmi) = do
   (seqs,js) <- mapAccumWithKeyM (addPMCFG opts gr cenv opath am cm) Map.empty (jments cmi)
-  when (verbAtLeast opts Verbose) $ liftIO $ hPutStrLn stderr ""
+  when (verbAtLeast opts Verbose) $ ePutStrLn ""
   return (cm,cmi{mseqs = Just (mkSetArray seqs), jments = js})
   where
     cenv = resourceValues gr
@@ -87,9 +85,9 @@ addPMCFG opts gr cenv opath am cm seqs id (GF.Grammar.CncFun mty@(Just (cat,cont
                        !funs_cnt        = e-s+1
                    in (prods_cnt,funs_cnt)
 
-  when (verbAtLeast opts Verbose) $ liftIO $ hPutStr stderr ("\n+ "++showIdent id ++ " " ++ show (product (map catFactor pargs)))
+  when (verbAtLeast opts Verbose) $ ePutStr ("\n+ "++showIdent id ++ " " ++ show (product (map catFactor pargs)))
   seqs1 `seq` stats `seq` return ()
-  when (verbAtLeast opts Verbose) $ liftIO $ hPutStr stderr (" "++show stats)
+  when (verbAtLeast opts Verbose) $ ePutStr (" "++show stats)
   return (seqs1,GF.Grammar.CncFun mty mlin mprn (Just pmcfg))
   where
     (ctxt,res,_) = err bug typeForm (lookupFunType gr am id)
@@ -128,7 +126,7 @@ addPMCFG opts gr cenv opath am cm seqs id (GF.Grammar.CncCat mty@(Just (L _ linc
 
   let pmcfg     = getPMCFG pmcfgEnv2
 
-  when (verbAtLeast opts Verbose) $ liftIO $ hPutStr stderr ("\n+ "++showIdent id++" "++show (catFactor pcat))
+  when (verbAtLeast opts Verbose) $ ePutStr ("\n+ "++showIdent id++" "++show (catFactor pcat))
   seqs2 `seq` pmcfg `seq` return (seqs2,GF.Grammar.CncCat mty mdef mref mprn (Just pmcfg))
   where
     addLindef lins (newCat', newArgs') env0 =
diff --git a/src/compiler/GF/Compile/ReadFiles.hs b/src/compiler/GF/Compile/ReadFiles.hs
index de95cb30a..54abc7f48 100644
--- a/src/compiler/GF/Compile/ReadFiles.hs
+++ b/src/compiler/GF/Compile/ReadFiles.hs
@@ -35,8 +35,6 @@ import GF.Grammar.Grammar
 import GF.Grammar.Binary
 
 import Control.Monad
---import Data.Char
---import Data.List
 import Data.Maybe(isJust)
 import qualified Data.ByteString.Char8 as BS
 import qualified Data.Map as Map
@@ -52,11 +50,11 @@ type ModEnv  = Map.Map ModName (UTCTime,[ModName])
 
 -- | Returns a list of all files to be compiled in topological order i.e.
 -- the low level (leaf) modules are first.
-getAllFiles :: Options -> [InitPath] -> ModEnv -> FileName -> IOE [FullPath]
+getAllFiles :: (MonadIO m,ErrorMonad m) => Options -> [InitPath] -> ModEnv -> FileName -> m [FullPath]
 getAllFiles opts ps env file = do
   -- read module headers from all files recursively
   ds <- liftM reverse $ get [] [] (justModuleName file)
-  ioeIO $ putIfVerb opts $ "all modules:" +++ show [name | (name,_,_,_,_,_) <- ds]
+  liftIO $ putIfVerb opts $ "all modules:" +++ show [name | (name,_,_,_,_,_) <- ds]
   return $ paths ds
   where
     -- construct list of paths to read
@@ -71,12 +69,12 @@ getAllFiles opts ps env file = do
 
     -- | traverses the dependency graph and returns a topologicaly sorted
     -- list of ModuleInfo. An error is raised if there is circular dependency
-    get :: [ModName]          -- ^ keeps the current path in the dependency graph to avoid cycles
+ {- get :: [ModName]          -- ^ keeps the current path in the dependency graph to avoid cycles
         -> [ModuleInfo]       -- ^ a list of already traversed modules
         -> ModName            -- ^ the current module
-        -> IOE [ModuleInfo]   -- ^ the final 
+        -> IOE [ModuleInfo]   -- ^ the final -}
     get trc ds name
-      | name `elem` trc = ioeErr $ Bad $ "circular modules" +++ unwords trc
+      | name `elem` trc = raise $ "circular modules" +++ unwords trc
       | (not . null) [n | (n,_,_,_,_,_) <- ds, name == n]     --- file already read
                         = return ds
       | otherwise       = do
@@ -91,20 +89,20 @@ getAllFiles opts ps env file = do
 
     -- searches for module in the search path and if it is found
     -- returns 'ModuleInfo'. It fails if there is no such module
-    findModule :: ModName -> IOE ModuleInfo
+  --findModule :: ModName -> IOE ModuleInfo
     findModule name = do
       (file,gfTime,gfoTime) <- do
-          mb_gfFile <- ioeIO $ getFilePath ps (gfFile name)
+          mb_gfFile <- getFilePath ps (gfFile name)
           case mb_gfFile of
-            Just gfFile -> do gfTime  <- ioeIO $ toUTCTime `fmap` getModificationTime gfFile
-                              mb_gfoTime <- ioeIO $ catch (liftM Just $ toUTCTime `fmap` getModificationTime (gf2gfo opts gfFile))
+            Just gfFile -> do gfTime  <- liftIO $ toUTCTime `fmap` getModificationTime gfFile
+                              mb_gfoTime <- liftIO $ catch (liftM Just $ toUTCTime `fmap` getModificationTime (gf2gfo opts gfFile))
                                                           (\_->return Nothing)
                               return (gfFile, Just gfTime, mb_gfoTime)
-            Nothing     -> do mb_gfoFile <- ioeIO $ getFilePath (maybe id (:) (flag optGFODir opts) ps) (gfoFile name)
+            Nothing     -> do mb_gfoFile <- getFilePath (maybe id (:) (flag optGFODir opts) ps) (gfoFile name)
                               case mb_gfoFile of
-                                Just gfoFile -> do gfoTime <- ioeIO $ toUTCTime `fmap` getModificationTime gfoFile
+                                Just gfoFile -> do gfoTime <- liftIO $ toUTCTime `fmap` getModificationTime gfoFile
                                                    return (gfoFile, Nothing, Just gfoTime)
-                                Nothing      -> ioeErr $ Bad (render (text "File" <+> text (gfFile name) <+> text "does not exist." $$
+                                Nothing      -> raise (render (text "File" <+> text (gfFile name) <+> text "does not exist." $$
                                                                       text "searched in:" <+> vcat (map text ps)))
 
 
@@ -114,21 +112,21 @@ getAllFiles opts ps env file = do
       (st,(mname,imps)) <-
                       case st of
                         CSEnv  -> return (st, (name, maybe [] snd mb_envmod))
-                        CSRead -> do mb_mo <- ioeIO $ decodeModuleHeader ((if isGFO file then id else gf2gfo opts) file)
+                        CSRead -> do mb_mo <- liftIO $ decodeModuleHeader ((if isGFO file then id else gf2gfo opts) file)
                                      case mb_mo of
                                        Just mo -> return (st,importsOfModule mo)
                                        Nothing
-                                         | isGFO file -> ioeErr $ Bad (file ++ " is compiled with different GF version and I can't find the source file")
-                                         | otherwise  -> do s <- ioeIO $ BS.readFile file
+                                         | isGFO file -> raise (file ++ " is compiled with different GF version and I can't find the source file")
+                                         | otherwise  -> do s <- liftIO $ BS.readFile file
                                                             case runP pModHeader s of
-                                                              Left (Pn l c,msg) -> ioeBad (file ++ ":" ++ show l ++ ":" ++ show c ++ ": " ++ msg)
+                                                              Left (Pn l c,msg) -> raise (file ++ ":" ++ show l ++ ":" ++ show c ++ ": " ++ msg)
                                                               Right mo          -> return (CSComp,importsOfModule mo)
-                        CSComp -> do s <- ioeIO $ BS.readFile file
+                        CSComp -> do s <- liftIO $ BS.readFile file
                                      case runP pModHeader s of
-                                       Left (Pn l c,msg) -> ioeBad (file ++ ":" ++ show l ++ ":" ++ show c ++ ": " ++ msg)
+                                       Left (Pn l c,msg) -> raise (file ++ ":" ++ show l ++ ":" ++ show c ++ ": " ++ msg)
                                        Right mo          -> return (st,importsOfModule mo)
-      ioeErr $ testErr (mname == name)
-                       ("module name" +++ mname +++ "differs from file name" +++ name)
+      testErr (mname == name)
+              ("module name" +++ mname +++ "differs from file name" +++ name)
       return (name,st,t,isJust gfTime,imps,dropFileName file)
 
 isGFO :: FilePath -> Bool
@@ -212,16 +210,16 @@ importsOfModule (m,mi) = (modName m,depModInfo mi [])
     modName = showIdent
 
 -- | options can be passed to the compiler by comments in @--#@, in the main file
-getOptionsFromFile :: FilePath -> IOE Options
+getOptionsFromFile :: (MonadIO m,ErrorMonad m) => FilePath -> m Options
 getOptionsFromFile file = do
-  s <- ioe $ catch (fmap Ok $ BS.readFile file)
-                   (\_ -> return (Bad $ "File " ++ file ++ " does not exist"))
+  s <- handle (liftIO $ BS.readFile file)
+              (\_ -> raise $ "File " ++ file ++ " does not exist")
   let ls = filter (BS.isPrefixOf (BS.pack "--#")) $ BS.lines s
       fs = map (BS.unpack . BS.unwords . BS.words . BS.drop 3) ls
-  ioeErr $ parseModuleOptions fs
+  liftErr $ parseModuleOptions fs
 
-getFilePath :: [FilePath] -> String -> IO (Maybe FilePath)
-getFilePath paths file = get paths
+getFilePath :: MonadIO m => [FilePath] -> String -> m (Maybe FilePath)
+getFilePath paths file = liftIO $ get paths
   where
     get []     = return Nothing
     get (p:ps) = do
diff --git a/src/compiler/GF/Compile/Rename.hs b/src/compiler/GF/Compile/Rename.hs
index 7effded1d..8821d99ca 100644
--- a/src/compiler/GF/Compile/Rename.hs
+++ b/src/compiler/GF/Compile/Rename.hs
@@ -45,7 +45,7 @@ import Text.PrettyPrint
 -- | this gives top-level access to renaming term input in the cc command
 renameSourceTerm :: SourceGrammar -> Ident -> Term -> Check Term
 renameSourceTerm g m t = do
-  mi     <- checkErr $ lookupModule g m
+  mi     <- lookupModule g m
   status <- buildStatus g (m,mi)
   renameTerm status [] t
 
@@ -72,12 +72,12 @@ renameIdentTerm' env@(act,imps) t0 =
     Cn c -> ident (\_ s -> checkError s) c
     Q (m',c) | m' == cPredef {- && isInPredefined c -} -> return t0
     Q (m',c) -> do
-      m <- checkErr (lookupErr m' qualifs)
+      m <- lookupErr m' qualifs
       f <- lookupTree showIdent c m
       return $ f c
     QC (m',c) | m' == cPredef {- && isInPredefined c -} -> return t0
     QC (m',c) -> do
-      m <- checkErr (lookupErr m' qualifs)
+      m <- lookupErr m' qualifs
       f <- lookupTree showIdent c m
       return $ f c
     _ -> return t0
@@ -127,7 +127,7 @@ buildStatus :: SourceGrammar -> SourceModule -> Check Status
 buildStatus gr mo@(m,mi) = checkIn (ppLocation (msrc mi) NoLoc <> colon) $ do
   let gr1  = prependModule gr mo
       exts = [(OSimple m,mi) | (m,mi) <- allExtends gr1 m]
-  ops <- checkErr $ mapM (\o -> lookupModule gr1 (openedModule o) >>= \mi -> return (o,mi)) (mopens mi)
+  ops <- mapM (\o -> lookupModule gr1 (openedModule o) >>= \mi -> return (o,mi)) (mopens mi)
   let sts = map modInfo2status (exts++ops)
   return (if isModCnc mi
             then (emptyBinTree,    reverse sts)  -- the module itself does not define any names
diff --git a/src/compiler/GF/Compile/Tags.hs b/src/compiler/GF/Compile/Tags.hs
index 16391c61b..10be24f16 100644
--- a/src/compiler/GF/Compile/Tags.hs
+++ b/src/compiler/GF/Compile/Tags.hs
@@ -19,7 +19,7 @@ writeTags opts gr file mo = do
   let imports = getImports opts gr mo
       locals  = getLocalTags [] mo
       txt     = unlines ((Set.toList . Set.fromList) (imports++locals))
-  putPointE Normal opts ("  write file" +++ file) $ ioeIO $ writeFile file txt
+  putPointE Normal opts ("  write file" +++ file) $ liftIO $ writeFile file txt
 
 getLocalTags x (m,mi) = 
   [showIdent i ++ "\t" ++ k ++ "\t" ++ l ++ "\t" ++ t 
diff --git a/src/compiler/GF/Compile/TypeCheck/Concrete.hs b/src/compiler/GF/Compile/TypeCheck/Concrete.hs
index 67634d4f1..f13da4e01 100644
--- a/src/compiler/GF/Compile/TypeCheck/Concrete.hs
+++ b/src/compiler/GF/Compile/TypeCheck/Concrete.hs
@@ -23,7 +23,7 @@ computeLType gr g0 t = comp (reverse [(b,x, Vr x) | (b,x,_) <- g0] ++ g0) t
       | isPredefConstant ty     -> return ty ---- shouldn't be needed
 
     Q (m,ident) -> checkIn (text "module" <+> ppIdent m) $ do
-      ty' <- checkErr (lookupResDef gr (m,ident)) 
+      ty' <- lookupResDef gr (m,ident)
       if ty' == ty then return ty else comp g ty' --- is this necessary to test?
 
     Vr ident  -> checkLookup ident g -- never needed to compute!
@@ -50,7 +50,7 @@ computeLType gr g0 t = comp (reverse [(b,x, Vr x) | (b,x,_) <- g0] ++ g0) t
       r' <- comp g r
       s' <- comp g s
       case (r',s') of
-        (RecType rs, RecType ss) -> checkErr (plusRecType r' s') >>= comp g
+        (RecType rs, RecType ss) -> plusRecType r' s' >>= comp g
         _ -> return $ ExtR r' s'
 
     RecType fs -> do
@@ -59,7 +59,7 @@ computeLType gr g0 t = comp (reverse [(b,x, Vr x) | (b,x,_) <- g0] ++ g0) t
 
     ELincat c t -> do
       t' <- comp g t
-      checkErr $ lockRecType c t' ---- locking to be removed AR 20/6/2009
+      lockRecType c t' ---- locking to be removed AR 20/6/2009
 
     _ | ty == typeTok -> return typeStr
     _ | isPredefConstant ty -> return ty
@@ -76,9 +76,9 @@ inferLType gr g trm = case trm of
                                                 Nothing -> checkError (text "unknown in Predef:" <+> ppIdent ident)
 
    Q ident -> checks [
-     termWith trm $ checkErr (lookupResType gr ident) >>= computeLType gr g
+     termWith trm $ lookupResType gr ident >>= computeLType gr g
      ,
-     checkErr (lookupResDef gr ident) >>= inferLType gr g
+     lookupResDef gr ident >>= inferLType gr g
      ,
      checkError (text "cannot infer type of constant" <+> ppTerm Unqualified 0 trm)
      ]
@@ -88,9 +88,9 @@ inferLType gr g trm = case trm of
                                                  Nothing -> checkError (text "unknown in Predef:" <+> ppIdent ident)
 
    QC ident -> checks [
-       termWith trm $ checkErr (lookupResType gr ident) >>= computeLType gr g
+       termWith trm $ lookupResType gr ident >>= computeLType gr g
        ,
-       checkErr (lookupResDef gr ident) >>= inferLType gr g
+       lookupResDef gr ident >>= inferLType gr g
        ,
        checkError (text "cannot infer type of canonical constant" <+> ppTerm Unqualified 0 trm)
        ]
@@ -214,10 +214,10 @@ inferLType gr g trm = case trm of
      sT'     <- computeLType gr g sT
 
      let trm' = ExtR r' s'
-     ---- trm'    <- checkErr $ plusRecord r' s'
+     ---- trm'    <- plusRecord r' s'
      case (rT', sT') of
        (RecType rs, RecType ss) -> do
-         rt <- checkErr $ plusRecType rT' sT'
+         rt <- plusRecType rT' sT'
          checkLType gr g trm' rt ---- return (trm', rt)
        _ | rT' == typeType && sT' == typeType -> return (trm', typeType)
        _ -> checkError (text "records or record types expected in" <+> ppTerm Unqualified 0 trm)
@@ -249,7 +249,7 @@ inferLType gr g trm = case trm of
 
    ELin c trm -> do
      (trm',ty) <- inferLType gr g trm
-     ty' <- checkErr $ lockRecType c ty ---- lookup c; remove lock AR 20/6/2009
+     ty' <- lockRecType c ty ---- lookup c; remove lock AR 20/6/2009
      return $ (ELin c trm', ty') 
 
    _ -> checkError (text "cannot infer lintype of" <+> ppTerm Unqualified 0 trm)
@@ -289,7 +289,7 @@ inferLType gr g trm = case trm of
      _ -> False
 
    inferPatt p = case p of
-     PP (q,c) ps | q /= cPredef -> checkErr $ liftM valTypeCnc (lookupResType gr (q,c))
+     PP (q,c) ps | q /= cPredef -> liftM valTypeCnc (lookupResType gr (q,c))
      PAs _ p  -> inferPatt p
      PNeg p   -> inferPatt p
      PAlt p q -> checks [inferPatt p, inferPatt q]
@@ -423,7 +423,7 @@ checkLType gr g trm typ0 = do
         case allParamValues gr arg of
           Ok vs -> do
             let ps0 = map fst cs
-            ps <- checkErr $ testOvershadow ps0 vs
+            ps <- testOvershadow ps0 vs
             if null ps 
               then return () 
               else checkWarn (text "patterns never reached:" $$
@@ -511,7 +511,7 @@ checkLType gr g trm typ0 = do
         checkLType gr g (Let (x,(Just ty,def')) body) typ
 
     ELin c tr -> do
-      tr1 <- checkErr $ unlockRecord c tr
+      tr1 <- unlockRecord c tr
       checkLType gr g tr1 typ
 
     _ -> do
@@ -547,7 +547,7 @@ pattContext :: SourceGrammar -> Context -> Type -> Patt -> Check Context
 pattContext env g typ p = case p of
   PV x -> return [(Explicit,x,typ)]
   PP (q,c) ps | q /= cPredef -> do ---- why this /=? AR 6/1/2006
-    t <- checkErr $ lookupResType env (q,c)
+    t <- lookupResType env (q,c)
     let (cont,v) = typeFormCnc t
     checkCond (text "wrong number of arguments for constructor in" <+> ppPatt Unqualified 0 p) 
               (length cont == length ps)
diff --git a/src/compiler/GF/Compile/Update.hs b/src/compiler/GF/Compile/Update.hs
index 54adcac2c..094414648 100644
--- a/src/compiler/GF/Compile/Update.hs
+++ b/src/compiler/GF/Compile/Update.hs
@@ -55,7 +55,7 @@ extendModule gr (name,m)
                                                  return (name,m')
  where
    extOne mo (n,cond) = do
-     m0 <- checkErr $ lookupModule gr n
+     m0 <- lookupModule gr n
 
      -- test that the module types match, and find out if the old is complete
      unless (sameMType (mtype m) (mtype mo)) 
@@ -93,7 +93,7 @@ rebuildModule gr mo@(i,mi@(ModInfo mt stat fs_ me mw ops_ med_ msrc_ env_ js_))
                           text "has open interfaces and must therefore be declared incomplete"))
       case mt of
         MTInstance (i0,mincl) -> do
-          m1 <- checkErr $ lookupModule gr i0
+          m1 <- lookupModule gr i0
           unless (isModRes m1)
                  (checkError (text "interface expected instead of" <+> ppIdent i0))
           js' <- extendMod gr False ((i0,m1), isInherited mincl) i (jments mi)
@@ -101,7 +101,7 @@ rebuildModule gr mo@(i,mi@(ModInfo mt stat fs_ me mw ops_ med_ msrc_ env_ js_))
           case extends mi of
             []  -> return mi{jments=js'}
             j0s -> do
-                m0s <- checkErr $ mapM (lookupModule gr) j0s
+                m0s <- mapM (lookupModule gr) j0s
                 let notInM0 c _  = all (not . isInBinTree c . jments) m0s
                 let js2 = filterBinTree notInM0 js'
                 return mi{jments=js2}
@@ -114,7 +114,7 @@ rebuildModule gr mo@(i,mi@(ModInfo mt stat fs_ me mw ops_ med_ msrc_ env_ js_))
                     [i | i <- is, notElem i infs]
       unless (stat' == MSComplete || stat == MSIncomplete) 
              (checkError (text "module" <+> ppIdent i <+> text "remains incomplete"))
-      ModInfo mt0 _ fs me' _ ops0 _ fpath _ js <- checkErr $ lookupModule gr ext
+      ModInfo mt0 _ fs me' _ ops0 _ fpath _ js <- lookupModule gr ext
       let ops1 = nub $
                    ops_ ++ -- N.B. js has been name-resolved already
                    [OQualif i j | (i,j) <- ops] ++
@@ -145,10 +145,10 @@ extendMod gr isCompl ((name,mi),cond) base new = foldM try new $ Map.toList (jme
                          Just j -> case unifyAnyInfo name i j of
 		                     Ok k  -> return $ updateTree (c,k) new
 		                     Bad _ -> do (base,j) <- case j of 
-		                                               AnyInd _ m -> checkErr $ lookupOrigInfo gr (m,c)
+		                                               AnyInd _ m -> lookupOrigInfo gr (m,c)
 		                                               _          -> return (base,j)
 		                                 (name,i) <- case i of 
-                                                               AnyInd _ m -> checkErr $ lookupOrigInfo gr (m,c)
+                                                               AnyInd _ m -> lookupOrigInfo gr (m,c)
                                                                _          -> return (name,i)
 		                                 checkError (text "cannot unify the information" $$ 
 		                                             nest 4 (ppJudgement Qualified (c,i)) $$