summaryrefslogtreecommitdiff
path: root/src/compiler/GFC.hs
diff options
context:
space:
mode:
authorhallgren <hallgren@chalmers.se>2014-10-15 21:04:29 +0000
committerhallgren <hallgren@chalmers.se>2014-10-15 21:04:29 +0000
commitb70dba87bab5dfc8039f0b9f69e0851f92324f8b (patch)
tree891cda8fd263b768232f930cabaf0769fb976737 /src/compiler/GFC.hs
parent393dde2eb93a975442697c177dbb161e4300bea0 (diff)
Rename modules GFI, GFC & GFServer...
... to GF.Interactive, GF.Compiler & GF.Server, respectively.
Diffstat (limited to 'src/compiler/GFC.hs')
-rw-r--r--src/compiler/GFC.hs144
1 files changed, 0 insertions, 144 deletions
diff --git a/src/compiler/GFC.hs b/src/compiler/GFC.hs
deleted file mode 100644
index 4b88bd998..000000000
--- a/src/compiler/GFC.hs
+++ /dev/null
@@ -1,144 +0,0 @@
-module GFC (mainGFC, writePGF) where
--- module Main where
-
-import PGF
-import PGF.Internal(concretes,optimizePGF,unionPGF)
-import PGF.Internal(putSplitAbs,encodeFile,runPut)
-import GF.Compile as S(batchCompile,link,srcAbsName)
-import qualified GF.CompileInParallel as P(batchCompile)
-import GF.Compile.Export
-import GF.Compile.CFGtoPGF
-import GF.Compile.GetGrammar
-import GF.Grammar.CFG
-
-import GF.Infra.Ident(showIdent)
-import GF.Infra.UseIO
-import GF.Infra.Option
-import GF.Data.ErrM
-import GF.System.Directory
-
-import Data.Maybe
-import qualified Data.Map as Map
-import qualified Data.Set as Set
-import qualified Data.ByteString.Lazy as BSL
-import System.FilePath
-import Control.Monad(unless,forM_)
-
-mainGFC :: Options -> [FilePath] -> IO ()
-mainGFC opts fs = do
- r <- appIOE (case () of
- _ | null fs -> fail $ "No input files."
- _ | all (extensionIs ".cf") fs -> compileCFFiles opts fs
- _ | all (\f -> extensionIs ".gf" f || extensionIs ".gfo" f) fs -> compileSourceFiles opts fs
- _ | all (extensionIs ".pgf") fs -> unionPGFFiles opts fs
- _ -> fail $ "Don't know what to do with these input files: " ++ unwords fs)
- case r of
- Ok x -> return x
- Bad msg -> die $ if flag optVerbosity opts == Normal
- then ('\n':msg)
- else msg
- where
- extensionIs ext = (== ext) . takeExtension
-
-compileSourceFiles :: Options -> [FilePath] -> IOE ()
-compileSourceFiles opts fs =
- do (t_src,~cnc_grs@(~(cnc,gr):_)) <- batchCompile opts fs
- unless (flag optStopAfterPhase opts == Compile) $
- do let abs = showIdent (srcAbsName gr cnc)
- pgfFile = outputPath opts (grammarName' opts abs<.>"pgf")
- t_pgf <- if outputJustPGF opts
- then maybeIO $ getModificationTime pgfFile
- else return Nothing
- if t_pgf >= Just t_src
- then putIfVerb opts $ pgfFile ++ " is up-to-date."
- else do pgfs <- mapM (link opts)
- [(cnc,t_src,gr)|(cnc,gr)<-cnc_grs]
- let pgf = foldl1 unionPGF pgfs
- writePGF opts pgf
- writeOutputs opts pgf
- where
- batchCompile = maybe batchCompile' P.batchCompile (flag optJobs opts)
- batchCompile' opts fs = do (cnc,t,gr) <- S.batchCompile opts fs
- return (t,[(cnc,gr)])
-
-compileCFFiles :: Options -> [FilePath] -> IOE ()
-compileCFFiles opts fs = do
- rules <- fmap concat $ mapM (getCFRules opts) fs
- startCat <- case rules of
- (CFRule cat _ _ : _) -> return cat
- _ -> fail "empty CFG"
- let pgf = cf2pgf (last fs) (uniqueFuns (mkCFG startCat Set.empty rules))
- let cnc = justModuleName (last fs)
- unless (flag optStopAfterPhase opts == Compile) $
- do probs <- liftIO (maybe (return . defaultProbabilities) readProbabilitiesFromFile (flag optProbsFile opts) pgf)
- let pgf' = setProbabilities probs $ if flag optOptimizePGF opts then optimizePGF pgf else pgf
- writePGF opts pgf'
- writeOutputs opts pgf'
-
-unionPGFFiles :: Options -> [FilePath] -> IOE ()
-unionPGFFiles opts fs =
- if outputJustPGF opts
- then maybe doIt checkFirst (flag optName opts)
- else doIt
- where
- checkFirst name =
- do let pgfFile = outputPath opts (name <.> "pgf")
- sourceTime <- maximum `fmap` mapM getModificationTime fs
- targetTime <- maybeIO $ getModificationTime pgfFile
- if targetTime >= Just sourceTime
- then putIfVerb opts $ pgfFile ++ " is up-to-date."
- else doIt
-
- doIt =
- do pgfs <- mapM readPGFVerbose fs
- let pgf0 = foldl1 unionPGF pgfs
- pgf = if flag optOptimizePGF opts then optimizePGF pgf0 else pgf0
- pgfFile = outputPath opts (grammarName opts pgf <.> "pgf")
- if pgfFile `elem` fs
- then putStrLnE $ "Refusing to overwrite " ++ pgfFile
- else writePGF opts pgf
- writeOutputs opts pgf
-
- readPGFVerbose f =
- putPointE Normal opts ("Reading " ++ f ++ "...") $ liftIO $ readPGF f
-
-writeOutputs :: Options -> PGF -> IOE ()
-writeOutputs opts pgf = do
- sequence_ [writeOutput opts name str
- | fmt <- outputFormats opts,
- (name,str) <- exportPGF opts fmt pgf]
-
-writePGF :: Options -> PGF -> IOE ()
-writePGF opts pgf =
- if flag optSplitPGF opts then writeSplitPGF else writeNormalPGF
- where
- writeNormalPGF =
- do let outfile = outputPath opts (grammarName opts pgf <.> "pgf")
- writing opts outfile $ encodeFile outfile pgf
-
- writeSplitPGF =
- do let outfile = outputPath opts (grammarName opts pgf <.> "pgf")
- writing opts outfile $ BSL.writeFile outfile (runPut (putSplitAbs pgf))
- --encodeFile_ outfile (putSplitAbs pgf)
- forM_ (Map.toList (concretes pgf)) $ \cnc -> do
- let outfile = outputPath opts (showCId (fst cnc) <.> "pgf_c")
- writing opts outfile $ encodeFile outfile cnc
-
-
-writeOutput :: Options -> FilePath-> String -> IOE ()
-writeOutput opts file str = writing opts path $ writeUTF8File path str
- where path = outputPath opts file
-
--- * Useful helper functions
-
-grammarName :: Options -> PGF -> String
-grammarName opts pgf = grammarName' opts (showCId (abstractName pgf))
-grammarName' opts abs = fromMaybe abs (flag optName opts)
-
-outputFormats opts = [fmt | fmt <- flag optOutputFormats opts, fmt/=FmtByteCode]
-outputJustPGF opts = null (flag optOutputFormats opts) && not (flag optSplitPGF opts)
-
-outputPath opts file = maybe id (</>) (flag optOutputDir opts) file
-
-writing opts path io =
- putPointE Normal opts ("Writing " ++ path ++ "...") $ liftIO io