From 018c9838ed31571b699118ae75b1d62d5527fd77 Mon Sep 17 00:00:00 2001 From: hallgren Date: Wed, 20 Nov 2013 00:45:33 +0000 Subject: 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. --- src/compiler/GF/Compile/Update.hs | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) (limited to 'src/compiler/GF/Compile/Update.hs') 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)) $$ -- cgit v1.2.3