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.

1 files changed, 6 insertions, 6 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
      ]