From 0ea2798b3cc9bf60e99e01089ea2eddba64a9cbf Mon Sep 17 00:00:00 2001
From: krasimir <krasimir@chalmers.se>
Date: Thu, 17 Apr 2008 12:50:51 +0000
Subject: gf3 should not exit if there is a syntax error in the file

---
 src/GF/Devel/Compile.hs | 16 ++++++----------
 src/GF/Devel/GFC.hs     |  4 ++--
 2 files changed, 8 insertions(+), 12 deletions(-)

(limited to 'src/GF/Devel')

diff --git a/src/GF/Devel/Compile.hs b/src/GF/Devel/Compile.hs
index 1b6f2710e..149e49c5d 100644
--- a/src/GF/Devel/Compile.hs
+++ b/src/GF/Devel/Compile.hs
@@ -30,13 +30,12 @@ import GF.Devel.Arch
 import Control.Monad
 import System.Directory
 
-batchCompile :: Options -> [FilePath] -> IO SourceGrammar
+batchCompile :: Options -> [FilePath] -> IOE SourceGrammar
 batchCompile opts files = do
-  let defOpts = addOptions opts (options [emitCode])
-  egr <- appIOE $ foldM (compileModule defOpts) emptyCompileEnv files 
-  case egr of
-    Ok (_,gr) -> return gr
-    Bad s -> error s
+  (_,gr) <- foldM (compileModule defOpts) emptyCompileEnv files
+  return gr
+  where
+    defOpts = addOptions opts (options [emitCode])
 
 -- to output an intermediate stage
 intermOut :: Options -> Option -> String -> IOE ()
@@ -83,10 +82,7 @@ compileModule opts1 env file = do
   ioeIOIf $ putStrLn $ "modules to include:" +++ show names ----
   let sgr2 = MGrammar [m | m@(i,_) <- modules sgr, 
                            notElem (prt i) $ map fileBody names]
-  let env0 = (0,sgr2)
-  (e,mm) <- foldIOE (compileOne opts) env0 files
-  maybe (return ()) putStrLnE mm
-  return e
+  foldM (compileOne opts) (0,sgr2) files
 
 
 compileOne :: Options -> CompileEnv -> FullPath -> IOE CompileEnv
diff --git a/src/GF/Devel/GFC.hs b/src/GF/Devel/GFC.hs
index cbbad22ae..87af00b8b 100644
--- a/src/GF/Devel/GFC.hs
+++ b/src/GF/Devel/GFC.hs
@@ -18,7 +18,7 @@ mainGFC xx = do
   case opts of
     _ | oElem (iOpt "help") opts -> putStrLn usageMsg
     _ | oElem (iOpt "-make") opts -> do
-      gfcc <- compileToGFCC opts fs
+      gfcc <- appIOE (compileToGFCC opts fs) >>= err fail return
       let gfccFile = targetNameGFCC opts (absname gfcc)
       outputFile gfccFile (printGFCC gfcc)
       mapM_ (alsoPrint opts gfcc) printOptions
@@ -32,7 +32,7 @@ mainGFC xx = do
       mapM_ (alsoPrint opts gfcc) printOptions
       
     _ -> do
-      mapM_ (batchCompile opts) (map return fs)
+      appIOE (mapM_ (batchCompile opts) (map return fs)) >>= err fail return
       putStrLn "Done."
 
 targetName :: Options -> CId -> String
-- 
cgit v1.2.3