summaryrefslogtreecommitdiff
path: root/src/compiler
diff options
context:
space:
mode:
Diffstat (limited to 'src/compiler')
-rw-r--r--src/compiler/GF/CompileOne.hs24
1 files changed, 14 insertions, 10 deletions
diff --git a/src/compiler/GF/CompileOne.hs b/src/compiler/GF/CompileOne.hs
index 3851b1f79..6aac4011b 100644
--- a/src/compiler/GF/CompileOne.hs
+++ b/src/compiler/GF/CompileOne.hs
@@ -24,6 +24,7 @@ import GF.Infra.CheckM(runCheck')
import GF.Data.Operations(ErrorMonad,liftErr,(+++),done)
import GF.System.Directory(doesFileExist,getCurrentDirectory,renameFile)
+import System.FilePath(makeRelative)
import qualified Data.Map as Map
import GF.Text.Pretty(render,(<+>),($$)) --Doc,
import Control.Monad((<=<))
@@ -48,14 +49,15 @@ compileOne opts srcgr file =
-- | Read a compiled GF module.
-- Also undo common subexp optimization, to enable normal computations.
reuseGFO opts srcgr file =
- do sm00 <- putPointE Verbose opts ("+ reading" +++ file) $
+ do cwd <- getCurrentDirectory
+ let rfile = makeRelative cwd file
+ sm00 <- putPointE Verbose opts ("+ reading" +++ rfile) $
decodeModule file
let sm0 = (fst sm00,(snd sm00){mflags=mflags (snd sm00) `addOptions` opts})
idump opts Source sm0
let sm1 = unsubexpModule sm0
- cwd <- getCurrentDirectory
(sm,warnings) <- -- putPointE Normal opts "creating indirections" $
runCheck' opts $ extendModule cwd srcgr sm1
warnOut opts warnings
@@ -71,11 +73,12 @@ reuseGFO opts srcgr file =
-- stores it in a @.gfo@ file
-- (or a tags file, if running with the @-tags@ option)
useTheSource opts srcgr file =
- do sm <- putpOpt ("- parsing" +++ file)
- ("- compiling" +++ file ++ "... ")
+ do cwd <- getCurrentDirectory
+ let rfile = makeRelative cwd file
+ sm <- putpOpt ("- parsing" +++ rfile)
+ ("- compiling" +++ rfile ++ "... ")
(getSourceModule opts file)
idump opts Source sm
- cwd <- getCurrentDirectory
compileSourceModule opts cwd (Just file) srcgr sm
where
putpOpt v m act
@@ -85,7 +88,7 @@ useTheSource opts srcgr file =
type CompileSource = Grammar -> Module -> IOE OneOutput
---compileSourceModule :: Options -> FilePath -> Maybe FilePath -> CompileSource
+--compileSourceModule :: Options -> InitPath -> Maybe FilePath -> CompileSource
compileSourceModule opts cwd mb_gfFile gr =
if flag optTagsOnly opts
then generateTags <=< ifComplete middle <=< frontend
@@ -111,7 +114,7 @@ compileSourceModule opts cwd mb_gfFile gr =
generateGFO mo =
do let mb_gfo = fmap (gf2gfo opts) mb_gfFile
- maybeM (flip (writeGFO opts) mo) mb_gfo
+ maybeM (flip (writeGFO opts cwd) mo) mb_gfo
return (mb_gfo,mo)
generateTags mo =
@@ -135,12 +138,13 @@ compileSourceModule opts cwd mb_gfFile gr =
maybeM f = maybe done f
---writeGFO :: Options -> FilePath -> SourceModule -> IOE ()
-writeGFO opts file mo =
- putPointE Normal opts (" write file" +++ file) $
+--writeGFO :: Options -> InitPath -> FilePath -> SourceModule -> IOE ()
+writeGFO opts cwd file mo =
+ putPointE Normal opts (" write file" +++ rfile) $
do encodeModule tmp mo2
renameFile tmp file
where
+ rfile = makeRelative cwd file
tmp = file++".tmp"
mo2 = (m,mi{jments=Map.filter notAnyInd (jments mi)})
(m,mi) = subexpModule mo