mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-22 19:22:50 -06:00
gf3 should not exit if there is a syntax error in the file
This commit is contained in:
@@ -6,15 +6,22 @@ import GF.GFCC.API
|
|||||||
|
|
||||||
import GF.Devel.UseIO
|
import GF.Devel.UseIO
|
||||||
import GF.Infra.Option
|
import GF.Infra.Option
|
||||||
|
import GF.Data.ErrM
|
||||||
|
|
||||||
import Data.List (nubBy)
|
import Data.List (nubBy)
|
||||||
|
|
||||||
-- import a grammar in an environment where it extends an existing grammar
|
-- import a grammar in an environment where it extends an existing grammar
|
||||||
importGrammar :: MultiGrammar -> Options -> [FilePath] -> IO MultiGrammar
|
importGrammar :: MultiGrammar -> Options -> [FilePath] -> IO MultiGrammar
|
||||||
importGrammar mgr0 opts files = do
|
importGrammar mgr0 opts files =
|
||||||
gfcc2 <- case fileSuffix (last files) of
|
case fileSuffix (last files) of
|
||||||
s | elem s ["gf","gfo"] -> compileToGFCC opts files
|
s | elem s ["gf","gfo"] -> do
|
||||||
"gfcc" ->
|
res <- appIOE $ compileToGFCC opts files
|
||||||
mapM file2gfcc files >>= return . foldl1 unionGFCC
|
case res of
|
||||||
let gfcc3 = unionGFCC (gfcc mgr0) gfcc2
|
Ok gfcc2 -> do let gfcc3 = unionGFCC (gfcc mgr0) gfcc2
|
||||||
return $ MultiGrammar gfcc3
|
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
|
||||||
@@ -9,12 +9,12 @@ import GF.Infra.Option
|
|||||||
import GF.Devel.UseIO
|
import GF.Devel.UseIO
|
||||||
|
|
||||||
-- | Compiles a number of source files and builds a 'GFCC' structure for them.
|
-- | 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 =
|
compileToGFCC opts fs =
|
||||||
do gr <- batchCompile opts fs
|
do gr <- batchCompile opts fs
|
||||||
let name = justModuleName (last fs)
|
let name = justModuleName (last fs)
|
||||||
let (abs,gc0) = mkCanon2gfcc opts name gr
|
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
|
let opt = if oElem (iOpt "noopt") opts then id else optGFCC
|
||||||
par = if oElem (iOpt "noparse") opts then id else addParsers
|
par = if oElem (iOpt "noparse") opts then id else addParsers
|
||||||
return (par (opt gc1))
|
return (par (opt gc1))
|
||||||
|
|||||||
@@ -30,13 +30,12 @@ import GF.Devel.Arch
|
|||||||
import Control.Monad
|
import Control.Monad
|
||||||
import System.Directory
|
import System.Directory
|
||||||
|
|
||||||
batchCompile :: Options -> [FilePath] -> IO SourceGrammar
|
batchCompile :: Options -> [FilePath] -> IOE SourceGrammar
|
||||||
batchCompile opts files = do
|
batchCompile opts files = do
|
||||||
let defOpts = addOptions opts (options [emitCode])
|
(_,gr) <- foldM (compileModule defOpts) emptyCompileEnv files
|
||||||
egr <- appIOE $ foldM (compileModule defOpts) emptyCompileEnv files
|
return gr
|
||||||
case egr of
|
where
|
||||||
Ok (_,gr) -> return gr
|
defOpts = addOptions opts (options [emitCode])
|
||||||
Bad s -> error s
|
|
||||||
|
|
||||||
-- to output an intermediate stage
|
-- to output an intermediate stage
|
||||||
intermOut :: Options -> Option -> String -> IOE ()
|
intermOut :: Options -> Option -> String -> IOE ()
|
||||||
@@ -83,10 +82,7 @@ compileModule opts1 env file = do
|
|||||||
ioeIOIf $ putStrLn $ "modules to include:" +++ show names ----
|
ioeIOIf $ putStrLn $ "modules to include:" +++ show names ----
|
||||||
let sgr2 = MGrammar [m | m@(i,_) <- modules sgr,
|
let sgr2 = MGrammar [m | m@(i,_) <- modules sgr,
|
||||||
notElem (prt i) $ map fileBody names]
|
notElem (prt i) $ map fileBody names]
|
||||||
let env0 = (0,sgr2)
|
foldM (compileOne opts) (0,sgr2) files
|
||||||
(e,mm) <- foldIOE (compileOne opts) env0 files
|
|
||||||
maybe (return ()) putStrLnE mm
|
|
||||||
return e
|
|
||||||
|
|
||||||
|
|
||||||
compileOne :: Options -> CompileEnv -> FullPath -> IOE CompileEnv
|
compileOne :: Options -> CompileEnv -> FullPath -> IOE CompileEnv
|
||||||
|
|||||||
@@ -18,7 +18,7 @@ mainGFC xx = do
|
|||||||
case opts of
|
case opts of
|
||||||
_ | oElem (iOpt "help") opts -> putStrLn usageMsg
|
_ | oElem (iOpt "help") opts -> putStrLn usageMsg
|
||||||
_ | oElem (iOpt "-make") opts -> do
|
_ | oElem (iOpt "-make") opts -> do
|
||||||
gfcc <- compileToGFCC opts fs
|
gfcc <- appIOE (compileToGFCC opts fs) >>= err fail return
|
||||||
let gfccFile = targetNameGFCC opts (absname gfcc)
|
let gfccFile = targetNameGFCC opts (absname gfcc)
|
||||||
outputFile gfccFile (printGFCC gfcc)
|
outputFile gfccFile (printGFCC gfcc)
|
||||||
mapM_ (alsoPrint opts gfcc) printOptions
|
mapM_ (alsoPrint opts gfcc) printOptions
|
||||||
@@ -32,7 +32,7 @@ mainGFC xx = do
|
|||||||
mapM_ (alsoPrint opts gfcc) printOptions
|
mapM_ (alsoPrint opts gfcc) printOptions
|
||||||
|
|
||||||
_ -> do
|
_ -> do
|
||||||
mapM_ (batchCompile opts) (map return fs)
|
appIOE (mapM_ (batchCompile opts) (map return fs)) >>= err fail return
|
||||||
putStrLn "Done."
|
putStrLn "Done."
|
||||||
|
|
||||||
targetName :: Options -> CId -> String
|
targetName :: Options -> CId -> String
|
||||||
|
|||||||
Reference in New Issue
Block a user