mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-15 15:59:32 -06:00
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:
@@ -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
|
||||
|
||||
20
src/GF/Compile/API.hs
Normal file
20
src/GF/Compile/API.hs
Normal 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))
|
||||
@@ -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"
|
||||
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user