diff --git a/src/GF/Command/Importing.hs b/src/GF/Command/Importing.hs index 788dab20a..73589533d 100644 --- a/src/GF/Command/Importing.hs +++ b/src/GF/Command/Importing.hs @@ -1,12 +1,8 @@ module GF.Command.Importing (importGrammar) where -import GF.Devel.Compile -import GF.Devel.GrammarToGFCC -import GF.GFCC.OptimizeGFCC -import GF.GFCC.CheckGFCC +import GF.Compile.API import GF.GFCC.DataGFCC import GF.GFCC.API -import qualified GF.Command.AbsGFShell as C import GF.Devel.UseIO import GF.Infra.Option @@ -17,12 +13,7 @@ import Data.List (nubBy) importGrammar :: MultiGrammar -> Options -> [FilePath] -> IO MultiGrammar importGrammar mgr0 opts files = do gfcc2 <- case fileSuffix (last files) of - s | elem s ["gf","gfo"] -> do - gr <- batchCompile opts files - let name = justModuleName (last files) - let (abs,gfcc0) = mkCanon2gfcc opts name gr - gfcc1 <- checkGFCCio gfcc0 - return $ addParsers $ if oElem (iOpt "noopt") opts then gfcc1 else optGFCC gfcc1 + s | elem s ["gf","gfo"] -> compileToGFCC opts files "gfcc" -> mapM file2gfcc files >>= return . foldl1 unionGFCC let gfcc3 = unionGFCC (gfcc mgr0) gfcc2 diff --git a/src/GF/Compile/API.hs b/src/GF/Compile/API.hs new file mode 100644 index 000000000..b9726bc23 --- /dev/null +++ b/src/GF/Compile/API.hs @@ -0,0 +1,20 @@ +module GF.Compile.API (batchCompile, compileToGFCC) where + +import GF.Devel.Compile +import GF.Devel.GrammarToGFCC +import GF.GFCC.OptimizeGFCC +import GF.GFCC.CheckGFCC +import GF.GFCC.DataGFCC +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 opts fs = + do gr <- batchCompile opts fs + let name = justModuleName (last fs) + let (abs,gc0) = mkCanon2gfcc opts name gr + gc1 <- 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/GFC.hs b/src/GF/Devel/GFC.hs index 2cb9104c5..a72289a49 100644 --- a/src/GF/Devel/GFC.hs +++ b/src/GF/Devel/GFC.hs @@ -1,11 +1,9 @@ module GF.Devel.GFC (mainGFC) where -- module Main where -import GF.Devel.Compile +import GF.Compile.API import GF.Devel.PrintGFCC -import GF.Devel.GrammarToGFCC -import GF.GFCC.OptimizeGFCC -import GF.GFCC.CheckGFCC +import GF.GFCC.CId import GF.GFCC.DataGFCC import GF.GFCC.Raw.ParGFCCRaw import GF.GFCC.Raw.ConvertGFCC @@ -20,47 +18,43 @@ mainGFC xx = do case opts of _ | oElem (iOpt "help") opts -> putStrLn usageMsg _ | oElem (iOpt "-make") opts -> do - gr <- batchCompile opts fs - let name = justModuleName (last fs) - let (abs,gc0) = mkCanon2gfcc opts name gr - gc1 <- checkGFCCio gc0 - let gc = addParsers $ if oElem (iOpt "noopt") opts then gc1 else optGFCC gc1 - let target = targetName opts abs - let gfccFile = target ++ ".gfcc" - writeFile gfccFile (printGFCC gc) - putStrLn $ "wrote file " ++ gfccFile - mapM_ (alsoPrint opts target gc) printOptions + gfcc <- compileToGFCC opts fs + let gfccFile = targetNameGFCC opts (absname gfcc) + outputFile gfccFile (printGFCC gfcc) + mapM_ (alsoPrint opts gfcc) printOptions -- gfc -o target.gfcc source_1.gfcc ... source_n.gfcc _ | all ((=="gfcc") . fileSuffix) fs -> do gfccs <- mapM file2gfcc fs let gfcc = foldl1 unionGFCC gfccs - let abs = printCId $ absname gfcc - let target = targetName opts abs - let gfccFile = target ++ ".gfcc" - writeFile gfccFile (printGFCC gfcc) - putStrLn $ "wrote file " ++ gfccFile - mapM_ (alsoPrint opts target gfcc) printOptions + let gfccFile = targetNameGFCC opts (absname gfcc) + outputFile gfccFile (printGFCC gfcc) + mapM_ (alsoPrint opts gfcc) printOptions _ -> do mapM_ (batchCompile opts) (map return fs) putStrLn "Done." +targetName :: Options -> CId -> String targetName opts abs = case getOptVal opts (aOpt "target") of Just n -> n - _ -> abs + _ -> prIdent abs + +targetNameGFCC :: Options -> CId -> FilePath +targetNameGFCC opts abs = targetName opts abs ++ ".gfcc" ---- TODO: nicer and richer print options -alsoPrint opts abs gr (opt,name) = do +alsoPrint opts gr (opt,name) = do if oElem (iOpt opt) opts - then do - let outfile = name - let output = prGFCC opt gr - writeFile outfile output - putStrLn $ "wrote file " ++ outfile + then outputFile name (prGFCC opt gr) else return () +outputFile :: FilePath -> String -> IO () +outputFile outfile output = + do writeFile outfile output + putStrLn $ "wrote file " ++ outfile + printOptions = [ ("haskell","GSyntax.hs"), ("haskell_gadt","GSyntax.hs"), @@ -69,4 +63,4 @@ printOptions = [ ] usageMsg = - "usage: gfc (-h | --make (-noopt) (-target=PREFIX) (-js | -jsref | -haskell | -haskell_gadt)) (-src) FILES" + "usage: gfc (-h | --make (-noopt) (-noparse) (-target=PREFIX) (-js | -jsref | -haskell | -haskell_gadt)) (-src) FILES" diff --git a/src/GF/GFCC/API.hs b/src/GF/GFCC/API.hs index 0a3b37cc5..2152acc41 100644 --- a/src/GF/GFCC/API.hs +++ b/src/GF/GFCC/API.hs @@ -21,7 +21,7 @@ import GF.GFCC.Macros import GF.GFCC.DataGFCC import GF.GFCC.CId import GF.GFCC.Raw.ConvertGFCC -import GF.GFCC.Raw.ParGFCCRaw +import GF.GFCC.Raw.CombParGFCCRaw import GF.Command.PPrTree import GF.Data.ErrM