compilation line complete (but dysfunctional) for new GF internal format

This commit is contained in:
aarne
2007-12-08 15:15:18 +00:00
parent 0807b556be
commit 0b90d257f9
3 changed files with 7 additions and 44 deletions

View File

@@ -102,13 +102,12 @@ compileOne opts env@(_,srcgr) file = do
-- for compiled gf, read the file and update environment -- for compiled gf, read the file and update environment
-- also undo common subexp optimization, to enable normal computations -- also undo common subexp optimization, to enable normal computations
{- ----
"gfo" -> do "gfo" -> do
sm0 <- putp ("+ reading" +++ file) $ getSourceModule opts file sm0 <- putp ("+ reading" +++ file) $ getSourceModule opts file
let sm1 = unsubexpModule sm0 let sm1 = unsubexpModule sm0
sm <- {- putp "creating indirections" $ -} ioeErr $ extendModule mos sm1 sm <- {- putp "creating indirections" $ -} ioeErr $ extendModule srcgr sm1
extendCompileEnv env sm extendCompileEnv env sm
-}
-- for gf source, do full compilation and generate code -- for gf source, do full compilation and generate code
_ -> do _ -> do
@@ -124,9 +123,9 @@ compileOne opts env@(_,srcgr) file = do
(k',sm) <- compileSourceModule opts env sm0 (k',sm) <- compileSourceModule opts env sm0
let sm1 = sm ---- let sm1 = sm ----
---- if isConcr sm then shareModule sm else sm -- cannot expand Str ---- if isConcr sm then shareModule sm else sm -- cannot expand Str
---- cm <- putpp " generating code... " $ generateModuleCode opts path sm1 cm <- putpp " generating code... " $ generateModuleCode opts path sm1
---- -- sm is optimized before generation, but not in the env ---- -- sm is optimized before generation, but not in the env
---- let cm2 = unsubexpModule cm let cm2 = unsubexpModule cm
extendCompileEnvInt env (k',sm) ---- sm1 extendCompileEnvInt env (k',sm) ---- sm1
where where
isConcr (_,mi) = case mi of isConcr (_,mi) = case mi of
@@ -166,29 +165,6 @@ compileSourceModule opts env@(k,gr) mo@(i,mi) = do
return (k,moo) ---- return (k,moo) ----
{- ----
mo1 <- ioeErr $ rebuildModule mos mo
intermOut opts (iOpt "show_rebuild") (prMod mo1)
case mo1b of
(_,ModMod n) | not (isCompleteModule n) -> do
return (k,mo1b) -- refresh would fail, since not renamed
_ -> do
(mo3:_,warnings) <- putpp " type checking" $ ioeErr $ showCheckModule mos mo2
if null warnings then return () else putp warnings $ return ()
intermOut opts (iOpt "show_typecheck") (prMod mo3)
let eenv = () --- emptyEEnv
(mo4,eenv') <-
---- if oElem "check_only" opts
putpp " optimizing " $ ioeErr $ optimizeModule opts (mos,eenv) mo3r
return (k',mo4)
where
---- prDebug mo = ioeIO $ putStrLn $ prGrammar $ MGrammar [mo] ---- debug
prDebug mo = ioeIO $ print $ length $ lines $ prGrammar $ MGrammar [mo]
generateModuleCode :: Options -> InitPath -> SourceModule -> IOE SourceModule generateModuleCode :: Options -> InitPath -> SourceModule -> IOE SourceModule
generateModuleCode opts path minfo@(name,info) = do generateModuleCode opts path minfo@(name,info) = do
@@ -197,14 +173,13 @@ generateModuleCode opts path minfo@(name,info) = do
let minfo1 = subexpModule minfo0 let minfo1 = subexpModule minfo0
let minfo2 = minfo1 let minfo2 = minfo1
let (file,out) = (gfoFile pname, prGrammar (MGrammar [minfo2])) let (file,out) = (gfoFile pname, prGF (gfModules [minfo2]))
putp (" wrote file" +++ file) $ ioeIO $ writeFile file $ out putp (" wrote file" +++ file) $ ioeIO $ writeFile file $ out
return minfo2 return minfo2
where where
putp = putPointE opts putp = putPointE opts
putpp = putPointEsil opts putpp = putPointEsil opts
-}
-- auxiliaries -- auxiliaries

View File

@@ -1,4 +1,4 @@
module GF.Devel.GFtoGFCC (prGrammar2gfcc,mkCanon2gfcc) where module GF.Devel.Compile.GFtoGFCC (prGrammar2gfcc,mkCanon2gfcc) where
import GF.Devel.Compile.Factorize (unshareModule) import GF.Devel.Compile.Factorize (unshareModule)

View File

@@ -1,21 +1,9 @@
module Main where module Main where
import GF.Devel.Compile.Compile import GF.Devel.Compile.GFC
import GF.Data.Operations
import GF.Infra.Option ----
import System (getArgs) import System (getArgs)
main = do main = do
xx <- getArgs xx <- getArgs
mainGFC xx mainGFC xx
mainGFC :: [String] -> IO ()
mainGFC xx = do
let (opts,fs) = getOptions "-" xx
case opts of
_ -> do
mapM_ (batchCompile opts) (map return fs)
putStrLn "Done."