diff options
Diffstat (limited to 'src/GF')
| -rw-r--r-- | src/GF/Command/Importing.hs | 21 | ||||
| -rw-r--r-- | src/GF/Compile/API.hs | 4 | ||||
| -rw-r--r-- | src/GF/Devel/Compile.hs | 16 | ||||
| -rw-r--r-- | src/GF/Devel/GFC.hs | 4 |
4 files changed, 24 insertions, 21 deletions
diff --git a/src/GF/Command/Importing.hs b/src/GF/Command/Importing.hs index 73589533d..31c4983dc 100644 --- a/src/GF/Command/Importing.hs +++ b/src/GF/Command/Importing.hs @@ -6,15 +6,22 @@ import GF.GFCC.API import GF.Devel.UseIO import GF.Infra.Option +import GF.Data.ErrM import Data.List (nubBy) -- import a grammar in an environment where it extends an existing grammar importGrammar :: MultiGrammar -> Options -> [FilePath] -> IO MultiGrammar -importGrammar mgr0 opts files = do - gfcc2 <- case fileSuffix (last files) of - s | elem s ["gf","gfo"] -> compileToGFCC opts files - "gfcc" -> - mapM file2gfcc files >>= return . foldl1 unionGFCC - let gfcc3 = unionGFCC (gfcc mgr0) gfcc2 - return $ MultiGrammar gfcc3
\ No newline at end of file +importGrammar mgr0 opts files = + case fileSuffix (last files) of + s | elem s ["gf","gfo"] -> do + res <- appIOE $ compileToGFCC opts files + case res of + Ok gfcc2 -> do let gfcc3 = unionGFCC (gfcc mgr0) gfcc2 + return $ MultiGrammar gfcc3 + Bad msg -> do print msg + return mgr0 + "gfcc" -> do + gfcc2 <- mapM file2gfcc files >>= return . foldl1 unionGFCC + let gfcc3 = unionGFCC (gfcc mgr0) gfcc2 + return $ MultiGrammar gfcc3
\ No newline at end of file diff --git a/src/GF/Compile/API.hs b/src/GF/Compile/API.hs index b9726bc23..06baa1d47 100644 --- a/src/GF/Compile/API.hs +++ b/src/GF/Compile/API.hs @@ -9,12 +9,12 @@ import GF.Infra.Option import GF.Devel.UseIO -- | Compiles a number of source files and builds a 'GFCC' structure for them. -compileToGFCC :: Options -> [FilePath] -> IO GFCC +compileToGFCC :: Options -> [FilePath] -> IOE GFCC compileToGFCC opts fs = do gr <- batchCompile opts fs let name = justModuleName (last fs) let (abs,gc0) = mkCanon2gfcc opts name gr - gc1 <- checkGFCCio gc0 + gc1 <- ioeIO $ checkGFCCio gc0 let opt = if oElem (iOpt "noopt") opts then id else optGFCC par = if oElem (iOpt "noparse") opts then id else addParsers return (par (opt gc1)) 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 |