Added -noparse flag to gfc. In the process, I refactored GF.Devel.GFC and GF.Command.Importing to use a common source to gfcc compilation function in the new module GF.Compile.API.

This commit is contained in:
bringert
2008-01-04 14:51:20 +00:00
parent d54c209e9d
commit a68b2850e7
4 changed files with 45 additions and 40 deletions

View File

@@ -1,12 +1,8 @@
module GF.Command.Importing (importGrammar) where module GF.Command.Importing (importGrammar) where
import GF.Devel.Compile import GF.Compile.API
import GF.Devel.GrammarToGFCC
import GF.GFCC.OptimizeGFCC
import GF.GFCC.CheckGFCC
import GF.GFCC.DataGFCC import GF.GFCC.DataGFCC
import GF.GFCC.API import GF.GFCC.API
import qualified GF.Command.AbsGFShell as C
import GF.Devel.UseIO import GF.Devel.UseIO
import GF.Infra.Option import GF.Infra.Option
@@ -17,12 +13,7 @@ import Data.List (nubBy)
importGrammar :: MultiGrammar -> Options -> [FilePath] -> IO MultiGrammar importGrammar :: MultiGrammar -> Options -> [FilePath] -> IO MultiGrammar
importGrammar mgr0 opts files = do importGrammar mgr0 opts files = do
gfcc2 <- case fileSuffix (last files) of gfcc2 <- case fileSuffix (last files) of
s | elem s ["gf","gfo"] -> do s | elem s ["gf","gfo"] -> compileToGFCC opts files
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
"gfcc" -> "gfcc" ->
mapM file2gfcc files >>= return . foldl1 unionGFCC mapM file2gfcc files >>= return . foldl1 unionGFCC
let gfcc3 = unionGFCC (gfcc mgr0) gfcc2 let gfcc3 = unionGFCC (gfcc mgr0) gfcc2

20
src/GF/Compile/API.hs Normal file
View File

@@ -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))

View File

@@ -1,11 +1,9 @@
module GF.Devel.GFC (mainGFC) where module GF.Devel.GFC (mainGFC) where
-- module Main where -- module Main where
import GF.Devel.Compile import GF.Compile.API
import GF.Devel.PrintGFCC import GF.Devel.PrintGFCC
import GF.Devel.GrammarToGFCC import GF.GFCC.CId
import GF.GFCC.OptimizeGFCC
import GF.GFCC.CheckGFCC
import GF.GFCC.DataGFCC import GF.GFCC.DataGFCC
import GF.GFCC.Raw.ParGFCCRaw import GF.GFCC.Raw.ParGFCCRaw
import GF.GFCC.Raw.ConvertGFCC import GF.GFCC.Raw.ConvertGFCC
@@ -20,47 +18,43 @@ 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
gr <- batchCompile opts fs gfcc <- compileToGFCC opts fs
let name = justModuleName (last fs) let gfccFile = targetNameGFCC opts (absname gfcc)
let (abs,gc0) = mkCanon2gfcc opts name gr outputFile gfccFile (printGFCC gfcc)
gc1 <- checkGFCCio gc0 mapM_ (alsoPrint opts gfcc) printOptions
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
-- gfc -o target.gfcc source_1.gfcc ... source_n.gfcc -- gfc -o target.gfcc source_1.gfcc ... source_n.gfcc
_ | all ((=="gfcc") . fileSuffix) fs -> do _ | all ((=="gfcc") . fileSuffix) fs -> do
gfccs <- mapM file2gfcc fs gfccs <- mapM file2gfcc fs
let gfcc = foldl1 unionGFCC gfccs let gfcc = foldl1 unionGFCC gfccs
let abs = printCId $ absname gfcc let gfccFile = targetNameGFCC opts (absname gfcc)
let target = targetName opts abs outputFile gfccFile (printGFCC gfcc)
let gfccFile = target ++ ".gfcc" mapM_ (alsoPrint opts gfcc) printOptions
writeFile gfccFile (printGFCC gfcc)
putStrLn $ "wrote file " ++ gfccFile
mapM_ (alsoPrint opts target gfcc) printOptions
_ -> do _ -> do
mapM_ (batchCompile opts) (map return fs) mapM_ (batchCompile opts) (map return fs)
putStrLn "Done." putStrLn "Done."
targetName :: Options -> CId -> String
targetName opts abs = case getOptVal opts (aOpt "target") of targetName opts abs = case getOptVal opts (aOpt "target") of
Just n -> n Just n -> n
_ -> abs _ -> prIdent abs
targetNameGFCC :: Options -> CId -> FilePath
targetNameGFCC opts abs = targetName opts abs ++ ".gfcc"
---- TODO: nicer and richer print options ---- TODO: nicer and richer print options
alsoPrint opts abs gr (opt,name) = do alsoPrint opts gr (opt,name) = do
if oElem (iOpt opt) opts if oElem (iOpt opt) opts
then do then outputFile name (prGFCC opt gr)
let outfile = name
let output = prGFCC opt gr
writeFile outfile output
putStrLn $ "wrote file " ++ outfile
else return () else return ()
outputFile :: FilePath -> String -> IO ()
outputFile outfile output =
do writeFile outfile output
putStrLn $ "wrote file " ++ outfile
printOptions = [ printOptions = [
("haskell","GSyntax.hs"), ("haskell","GSyntax.hs"),
("haskell_gadt","GSyntax.hs"), ("haskell_gadt","GSyntax.hs"),
@@ -69,4 +63,4 @@ printOptions = [
] ]
usageMsg = 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"

View File

@@ -21,7 +21,7 @@ import GF.GFCC.Macros
import GF.GFCC.DataGFCC import GF.GFCC.DataGFCC
import GF.GFCC.CId import GF.GFCC.CId
import GF.GFCC.Raw.ConvertGFCC import GF.GFCC.Raw.ConvertGFCC
import GF.GFCC.Raw.ParGFCCRaw import GF.GFCC.Raw.CombParGFCCRaw
import GF.Command.PPrTree import GF.Command.PPrTree
import GF.Data.ErrM import GF.Data.ErrM