summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authoraarne <aarne@cs.chalmers.se>2007-12-08 15:15:18 +0000
committeraarne <aarne@cs.chalmers.se>2007-12-08 15:15:18 +0000
commitf4d3b1a9fa358208a6e975c6bc17ab2522c41b46 (patch)
tree6ec99c7d5a67881855c89feb5f5238aa9ae76307 /src
parente548f096e6d3be8408f83fcbdaf47122db3ed353 (diff)
compilation line complete (but dysfunctional) for new GF internal format
Diffstat (limited to 'src')
-rw-r--r--src/GF/Devel/Compile/Compile.hs35
-rw-r--r--src/GF/Devel/Compile/GFtoGFCC.hs2
-rw-r--r--src/GF/Devel/TestGF3.hs14
3 files changed, 7 insertions, 44 deletions
diff --git a/src/GF/Devel/Compile/Compile.hs b/src/GF/Devel/Compile/Compile.hs
index 70ba5e9c0..9feb2edb1 100644
--- a/src/GF/Devel/Compile/Compile.hs
+++ b/src/GF/Devel/Compile/Compile.hs
@@ -102,13 +102,12 @@ compileOne opts env@(_,srcgr) file = do
-- for compiled gf, read the file and update environment
-- also undo common subexp optimization, to enable normal computations
-{- ----
"gfo" -> do
sm0 <- putp ("+ reading" +++ file) $ getSourceModule opts file
let sm1 = unsubexpModule sm0
- sm <- {- putp "creating indirections" $ -} ioeErr $ extendModule mos sm1
+ sm <- {- putp "creating indirections" $ -} ioeErr $ extendModule srcgr sm1
extendCompileEnv env sm
--}
+
-- for gf source, do full compilation and generate code
_ -> do
@@ -124,9 +123,9 @@ compileOne opts env@(_,srcgr) file = do
(k',sm) <- compileSourceModule opts env sm0
let sm1 = sm ----
---- 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
----- let cm2 = unsubexpModule cm
+ let cm2 = unsubexpModule cm
extendCompileEnvInt env (k',sm) ---- sm1
where
isConcr (_,mi) = case mi of
@@ -166,29 +165,6 @@ compileSourceModule opts env@(k,gr) mo@(i,mi) = do
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 opts path minfo@(name,info) = do
@@ -197,14 +173,13 @@ generateModuleCode opts path minfo@(name,info) = do
let minfo1 = subexpModule minfo0
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
return minfo2
where
putp = putPointE opts
putpp = putPointEsil opts
--}
-- auxiliaries
diff --git a/src/GF/Devel/Compile/GFtoGFCC.hs b/src/GF/Devel/Compile/GFtoGFCC.hs
index d152b7b57..aaa55c895 100644
--- a/src/GF/Devel/Compile/GFtoGFCC.hs
+++ b/src/GF/Devel/Compile/GFtoGFCC.hs
@@ -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)
diff --git a/src/GF/Devel/TestGF3.hs b/src/GF/Devel/TestGF3.hs
index 5d869de14..da4b5c8f6 100644
--- a/src/GF/Devel/TestGF3.hs
+++ b/src/GF/Devel/TestGF3.hs
@@ -1,21 +1,9 @@
module Main where
-import GF.Devel.Compile.Compile
-
-import GF.Data.Operations
-import GF.Infra.Option ----
+import GF.Devel.Compile.GFC
import System (getArgs)
main = do
xx <- getArgs
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."