GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-05-22 09:32:53 -06:00
Code Issues Packages Projects Releases Wiki Activity

The --output-dir option now applies also to PGF files

Browse Source
This commit is contained in:
hallgren
2014-06-21 12:26:56 +00:00
parent eee9617036
commit 54d081a036
2 changed files with 42 additions and 42 deletions
Download Patch File Download Diff File Expand all files Collapse all files

5
WebSetup.hs
View File

@@ -48,7 +48,7 @@ buildWeb gf args flags pkg lbi =
dir = "examples"</>subdir dir = "examples"</>subdir
cmd = gf++" -make -s -optimize-pgf --gfo-dir="++tmp_dir++ cmd = gf++" -make -s -optimize-pgf --gfo-dir="++tmp_dir++
" --gf-lib-path="++buildDir lbi </> "rgl"++ " --gf-lib-path="++buildDir lbi </> "rgl"++
-- " --output-dir="++tmp_dir++ -- has no effect?! " --output-dir="++gfo_dir++
" "++unwords [dir</>file|file<-src] " "++unwords [dir</>file|file<-src]
installWeb gf args flags pki lbi = setupWeb gf args dest pki lbi installWeb gf args flags pki lbi = setupWeb gf args dest pki lbi
@@ -70,11 +70,12 @@ setupWeb gf args dest pkg lbi =
cloud_dir = www_dir </> "tmp" -- hmm cloud_dir = www_dir </> "tmp" -- hmm
logo_dir = www_dir </> "Logos" logo_dir = www_dir </> "Logos"
www_dir = datadir (absoluteInstallDirs pkg lbi dest) </> "www" www_dir = datadir (absoluteInstallDirs pkg lbi dest) </> "www"
gfo_dir = buildDir lbi </> "examples"
copy_pgf (pgf,subdir,_) = copy_pgf (pgf,subdir,_) =
do let dst = grammars_dir</>pgf do let dst = grammars_dir</>pgf
putStrLn $ "Installing "++dst putStrLn $ "Installing "++dst
copyFile pgf dst copyFile (gfo_dir</>pgf) dst
gf_logo = "gf0.png" gf_logo = "gf0.png"

77
src/compiler/GFC.hs
View File

@@ -2,7 +2,7 @@ module GFC (mainGFC, writePGF) where
-- module Main where -- module Main where
import PGF import PGF
import PGF.Internal(PGF(..),code,funs,cats,optimizePGF,unionPGF) import PGF.Internal(PGF,abstract,concretes,code,funs,cats,optimizePGF,unionPGF)
import PGF.Internal(putSplitAbs) import PGF.Internal(putSplitAbs)
import GF.Compile import GF.Compile
import GF.Compile.Export import GF.Compile.Export
@@ -24,7 +24,6 @@ import qualified Data.ByteString as BSS
import qualified Data.ByteString.Lazy as BSL import qualified Data.ByteString.Lazy as BSL
import System.FilePath import System.FilePath
import System.IO import System.IO
import Control.Exception(bracket)
import Control.Monad(unless,forM_) import Control.Monad(unless,forM_)
mainGFC :: Options -> [FilePath] -> IO () mainGFC :: Options -> [FilePath] -> IO ()
@@ -48,7 +47,7 @@ compileSourceFiles opts fs =
do cnc_gr@(cnc,t_src,gr) <- batchCompile opts fs do cnc_gr@(cnc,t_src,gr) <- batchCompile opts fs
unless (flag optStopAfterPhase opts == Compile) $ unless (flag optStopAfterPhase opts == Compile) $
do let abs = showIdent (srcAbsName gr cnc) do let abs = showIdent (srcAbsName gr cnc)
pgfFile = grammarName' opts abs<.>"pgf" pgfFile = outputPath opts (grammarName' opts abs<.>"pgf")
t_pgf <- if outputJustPGF opts t_pgf <- if outputJustPGF opts
then maybeIO $ getModificationTime pgfFile then maybeIO $ getModificationTime pgfFile
else return Nothing else return Nothing
@@ -80,7 +79,7 @@ unionPGFFiles opts fs =
else doIt else doIt
where where
checkFirst name = checkFirst name =
do let pgfFile = name <.> "pgf" do let pgfFile = outputPath opts (name <.> "pgf")
sourceTime <- liftIO $ maximum `fmap` mapM getModificationTime fs sourceTime <- liftIO $ maximum `fmap` mapM getModificationTime fs
targetTime <- maybeIO $ getModificationTime pgfFile targetTime <- maybeIO $ getModificationTime pgfFile
if targetTime >= Just sourceTime if targetTime >= Just sourceTime
@@ -91,7 +90,7 @@ unionPGFFiles opts fs =
do pgfs <- mapM readPGFVerbose fs do pgfs <- mapM readPGFVerbose fs
let pgf0 = foldl1 unionPGF pgfs let pgf0 = foldl1 unionPGF pgfs
pgf = if flag optOptimizePGF opts then optimizePGF pgf0 else pgf0 pgf = if flag optOptimizePGF opts then optimizePGF pgf0 else pgf0
pgfFile = grammarName opts pgf <.> "pgf" pgfFile = outputPath opts (grammarName opts pgf <.> "pgf")
if pgfFile `elem` fs if pgfFile `elem` fs
then putStrLnE $ "Refusing to overwrite " ++ pgfFile then putStrLnE $ "Refusing to overwrite " ++ pgfFile
else writePGF opts pgf else writePGF opts pgf
@@ -106,23 +105,13 @@ writeOutputs opts pgf = do
| fmt <- outputFormats opts, | fmt <- outputFormats opts,
(name,str) <- exportPGF opts fmt pgf] (name,str) <- exportPGF opts fmt pgf]
outputFormats opts = [fmt | fmt <- flag optOutputFormats opts, fmt/=FmtByteCode]
outputJustPGF opts = null (flag optOutputFormats opts) && not (flag optSplitPGF opts)
writeByteCode :: Options -> PGF -> IOE () writeByteCode :: Options -> PGF -> IOE ()
writeByteCode opts pgf writeByteCode opts pgf
| elem FmtByteCode (flag optOutputFormats opts) = | elem FmtByteCode (flag optOutputFormats opts) =
let name = fromMaybe (showCId (abstractName pgf)) (flag optName opts) let path = outputPath opts (grammarName opts pgf <.> "bc")
file = name <.> "bc" in writing opts path $
path = case flag optOutputDir opts of withBinaryFile path WriteMode
Nothing -> file (\h -> do BSL.hPut h (encode addrs)
Just dir -> dir </> file
in putPointE Normal opts ("Writing " ++ path ++ "...") $ liftIO $
bracket
(openFile path WriteMode)
(hClose)
(\h -> do hSetBinaryMode h True
BSL.hPut h (encode addrs)
BSS.hPut h (code (abstract pgf))) BSS.hPut h (code (abstract pgf)))
| otherwise = return () | otherwise = return ()
where where
@@ -131,26 +120,36 @@ writeByteCode opts pgf
[(id,addr) | (id,(_,_,_,addr)) <- Map.toList (cats (abstract pgf))] [(id,addr) | (id,(_,_,_,addr)) <- Map.toList (cats (abstract pgf))]
writePGF :: Options -> PGF -> IOE () writePGF :: Options -> PGF -> IOE ()
writePGF opts pgf writePGF opts pgf =
| flag optSplitPGF opts = do let outfile = grammarName opts pgf <.> "pgf" if flag optSplitPGF opts then writeSplitPGF else writeNormalPGF
putPointE Normal opts ("Writing " ++ outfile ++ "...") $ liftIO $ do where
--encodeFile_ outfile (putSplitAbs pgf) writeNormalPGF =
BSL.writeFile outfile (runPut (putSplitAbs pgf)) do let outfile = outputPath opts (grammarName opts pgf <.> "pgf")
forM_ (Map.toList (concretes pgf)) $ \cnc -> do writing opts outfile $ encodeFile outfile pgf
let outfile = showCId (fst cnc) <.> "pgf_c"
putPointE Normal opts ("Writing " ++ outfile ++ "...") $ liftIO $ encodeFile outfile cnc writeSplitPGF =
return () do let outfile = outputPath opts (grammarName opts pgf <.> "pgf")
| otherwise = do let outfile = grammarName opts pgf <.> "pgf" writing opts outfile $ BSL.writeFile outfile (runPut (putSplitAbs pgf))
putPointE Normal opts ("Writing " ++ outfile ++ "...") $ liftIO $ encodeFile outfile 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
grammarName :: Options -> PGF -> String
grammarName opts pgf = --fromMaybe (showCId (absname pgf)) (flag optName opts)
grammarName' opts (showCId (absname pgf))
grammarName' opts abs = fromMaybe abs (flag optName opts)
writeOutput :: Options -> FilePath-> String -> IOE () writeOutput :: Options -> FilePath-> String -> IOE ()
writeOutput opts file str = writeOutput opts file str = writing opts path $ writeUTF8File path str
putPointE Normal opts ("Writing " ++ path ++ "...") $ liftIO $ where path = outputPath opts file
writeUTF8File path str
where -- * Useful helper functions
path = maybe id (</>) (flag optOutputDir opts) file
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