summaryrefslogtreecommitdiff
path: root/src/compiler/GFC.hs
diff options
context:
space:
mode:
authorkrasimir <krasimir@chalmers.se>2009-12-13 18:50:29 +0000
committerkrasimir <krasimir@chalmers.se>2009-12-13 18:50:29 +0000
commitf85232947e74ee7ef8c7b0ad2338212e7e68f1be (patch)
tree667b886a5e3a4b026a63d4e3597f32497d824761 /src/compiler/GFC.hs
parentd88a865faff59c98fc91556ff8700b10ee5f2df8 (diff)
reorganize the directories under src, and rescue the JavaScript interpreter from deprecated
Diffstat (limited to 'src/compiler/GFC.hs')
-rw-r--r--src/compiler/GFC.hs88
1 files changed, 88 insertions, 0 deletions
diff --git a/src/compiler/GFC.hs b/src/compiler/GFC.hs
new file mode 100644
index 000000000..8037d4f1a
--- /dev/null
+++ b/src/compiler/GFC.hs
@@ -0,0 +1,88 @@
+module GFC (mainGFC) where
+-- module Main where
+
+import PGF
+import PGF.CId
+import PGF.Data
+import GF.Compile
+import GF.Compile.Export
+
+import GF.Grammar.CF ---- should this be on a deeper level? AR 15/10/2008
+
+import GF.Infra.UseIO
+import GF.Infra.Option
+import GF.Data.ErrM
+
+import Data.Maybe
+import Data.Binary
+import System.FilePath
+import System.IO
+
+
+mainGFC :: Options -> [FilePath] -> IOE ()
+mainGFC opts fs =
+ 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
+ where extensionIs ext = (== ext) . takeExtension
+
+compileSourceFiles :: Options -> [FilePath] -> IOE ()
+compileSourceFiles opts fs =
+ do gr <- batchCompile opts fs
+ let cnc = justModuleName (last fs)
+ if flag optStopAfterPhase opts == Compile
+ then return ()
+ else do pgf <- link opts cnc gr
+ writePGF opts pgf
+ writeOutputs opts pgf
+
+compileCFFiles :: Options -> [FilePath] -> IOE ()
+compileCFFiles opts fs =
+ do s <- ioeIO $ fmap unlines $ mapM readFile fs
+ let cnc = justModuleName (last fs)
+ gf <- ioeErr $ getCF cnc s
+ gr <- compileSourceGrammar opts gf
+ if flag optStopAfterPhase opts == Compile
+ then return ()
+ else do pgf <- link opts cnc gr
+ writePGF opts pgf
+ writeOutputs opts pgf
+
+unionPGFFiles :: Options -> [FilePath] -> IOE ()
+unionPGFFiles opts fs =
+ do pgfs <- mapM readPGFVerbose fs
+ let pgf = foldl1 unionPGF pgfs
+ pgfFile = grammarName opts pgf <.> "pgf"
+ if pgfFile `elem` fs
+ then putStrLnE $ "Refusing to overwrite " ++ pgfFile
+ else writePGF opts pgf
+ writeOutputs opts pgf
+ where readPGFVerbose f = putPointE Normal opts ("Reading " ++ f ++ "...") $ ioeIO $ readPGF f
+
+writeOutputs :: Options -> PGF -> IOE ()
+writeOutputs opts pgf = do
+ sequence_ [writeOutput opts name str
+ | fmt <- flag optOutputFormats opts,
+ (name,str) <- exportPGF opts fmt pgf]
+
+writePGF :: Options -> PGF -> IOE ()
+writePGF opts pgf = do
+ let outfile = grammarName opts pgf <.> "pgf"
+ putPointE Normal opts ("Writing " ++ outfile ++ "...") $ ioeIO $ encodeFile outfile pgf
+
+grammarName :: Options -> PGF -> String
+grammarName opts pgf = fromMaybe (showCId (absname pgf)) (flag optName opts)
+
+writeOutput :: Options -> FilePath-> String -> IOE ()
+writeOutput opts file str =
+ do let path = case flag optOutputDir opts of
+ Nothing -> file
+ Just dir -> dir </> file
+ writeOutputFile opts path str
+
+writeOutputFile :: Options -> FilePath -> String -> IOE ()
+writeOutputFile opts outfile output =
+ do putPointE Normal opts ("Writing " ++ outfile ++ "...") $ ioeIO $ writeFile outfile output