removed src for 2.9

1 files changed, 0 insertions, 401 deletions

diff --git a/src/GF/Compile/Compile.hs b/src/GF/Compile/Compile.hs
deleted file mode 100644
index 422df0fd5..000000000
--- a/src/GF/Compile/Compile.hs
+++ /dev/null
@@ -1,401 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Module      : Compile
--- Maintainer  : AR
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/10/05 20:02:19 $
--- > CVS $Author: aarne $
--- > CVS $Revision: 1.45 $
---
--- The top-level compilation chain from source file to gfc\/gfr.
------------------------------------------------------------------------------
-
-module GF.Compile.Compile (compileModule, compileEnvShSt, compileOne,
-		CompileEnv, TimedCompileEnv,gfGrammarPathVar,pathListOpts,
-	       getGFEFiles) where
-
-import GF.Grammar.Grammar
-import GF.Infra.Ident
-import GF.Infra.Option
-import GF.Infra.CompactPrint
-import GF.Grammar.PrGrammar
-import GF.Compile.Update
-import GF.Grammar.Lookup
-import GF.Infra.Modules
-import GF.Infra.ReadFiles
-import GF.Compile.ShellState
-import GF.Compile.MkResource
----- import MkUnion
-
--- the main compiler passes
-import GF.Compile.GetGrammar
-import GF.Compile.Extend
-import GF.Compile.Rebuild
-import GF.Compile.Rename
-import GF.Grammar.Refresh
-import GF.Compile.CheckGrammar
-import GF.Compile.Optimize
-import GF.Compile.Evaluate
-import GF.Compile.GrammarToCanon
---import GF.Devel.GrammarToGFCC -----
-import GF.Devel.OptimizeGF (subexpModule,unsubexpModule)
-import GF.Canon.Share
-import GF.Canon.Subexpressions (elimSubtermsMod,unSubelimModule)
-import GF.UseGrammar.Linear (unoptimizeCanonMod) ----
-
-import qualified GF.Canon.CanonToGrammar as CG
-
-import qualified GF.Canon.GFC as GFC
-import qualified GF.Canon.MkGFC as MkGFC
-import GF.Canon.GetGFC
-
-import GF.Data.Operations
-import GF.Infra.UseIO
-import GF.Text.UTF8 ----
-import GF.System.Arch
-
-import Control.Monad
-import System.Directory
-import System.FilePath
-
--- | in batch mode: write code in a file
-batchCompile f = liftM fst $ compileModule defOpts emptyShellState f
-  where
-    defOpts = options [emitCode] 
-batchCompileOpt f = liftM fst $ compileModule defOpts emptyShellState f
-  where
-    defOpts = options [emitCode, optimizeCanon] 
-
-batchCompileOld f = compileOld defOpts f
-  where
-    defOpts = options [emitCode] 
-
--- | compile with one module as starting point
--- command-line options override options (marked by --#) in the file
--- As for path: if it is read from file, the file path is prepended to each name.
--- If from command line, it is used as it is.
-compileModule :: Options -> ShellState -> FilePath -> IOE TimedCompileEnv
-----             IOE (GFC.CanonGrammar, (SourceGrammar,[(String,(FilePath,ModTime))]))
-
-compileModule opts st0 file | 
-     oElem showOld opts || 
-     elem suff [".cf",".ebnf",".gfm"] = do
-  let putp  = putPointE opts
-  let putpp = putPointEsil opts
-  let path = [] ----
-  grammar1 <- case suff of
-    ".cf"   -> putp ("- parsing" +++ suff +++ file) $ getCFGrammar opts file
-    ".ebnf" -> putp ("- parsing" +++ suff +++ file) $ getEBNFGrammar opts file
-    ".gfm"  -> putp ("- parsing" +++ suff +++ file) $ getSourceGrammar opts file
-    _       -> putp ("- parsing old gf" +++ file)   $ getOldGrammar opts file
-  let mods = modules grammar1
-  let env = compileEnvShSt st0 []
-  foldM (comp putpp path) env mods
- where
-   suff = takeExtensions file
-   comp putpp path env sm0 = do
-     (k',sm,eenv')  <- makeSourceModule opts (fst env) sm0
-     cm  <- putpp "  generating code... " $ generateModuleCode opts path sm
-     ft <- getReadTimes file ---
-     extendCompileEnvInt env (k',sm,cm) eenv' ft
-
-compileModule opts1 st0 file = do
-  opts0 <- ioeIO $ getOptionsFromFile file
-  let useFileOpt = maybe False (const True) $ getOptVal opts0 pathList
-  let useLineOpt = maybe False (const True) $ getOptVal opts1 pathList
-  let opts = addOptions opts1 opts0 
-  let fpath = dropFileName file
-  ps0 <- ioeIO $ pathListOpts opts fpath
-
-  let ps1 = if (useFileOpt && not useLineOpt) 
-              then (ps0 ++ map (combine fpath) ps0)
-              else ps0
-  ps <- ioeIO $ extendPathEnv ps1
-  let ioeIOIf = if oElem beVerbose opts then ioeIO else (const (return ()))
-  ioeIOIf $ putStrLn $ "module search path:" +++ show ps ----
-  let st = st0 --- if useFileOpt then emptyShellState else st0
-  let rfs = [(m,t) | (m,(_,t)) <- readFiles st]
-  let file' = if useFileOpt then takeFileName file else file -- to find file itself
-  files <- getAllFiles opts ps rfs file'
-  ioeIOIf $ putStrLn $ "files to read:" +++ show files ----
-  let names = map justModuleName files
-  ioeIOIf $ putStrLn $ "modules to include:" +++ show names ----
-  let env0 = compileEnvShSt st names
-  (e,mm) <- foldIOE (compileOne opts) env0 files
-  maybe (return ()) putStrLnE mm
-  return e
-
-getReadTimes file = do
-  t <- ioeIO getNowTime
-  let m = justModuleName file
-  return $ (m,(file,t)) : [(resModName m,(file,t)) | not (isGFC file)]
-
-compileEnvShSt :: ShellState -> [ModName] -> TimedCompileEnv
-compileEnvShSt st fs = ((0,sgr,cgr,eenv),fts) where
-  cgr = MGrammar [m | m@(i,_) <- modules (canModules st), notInc i]
-  sgr = MGrammar [m | m@(i,_) <- modules (srcModules st), notIns i]
-  notInc i = notElem (prt i) $ map dropExtension fs
-  notIns i = notElem (prt i) $ map dropExtension fs
-  fts = readFiles st
-  eenv = evalEnv st
-
-pathListOpts :: Options -> FileName -> IO [InitPath]
-pathListOpts opts file = return $ maybe [file] splitInModuleSearchPath $ getOptVal opts pathList
-
-reverseModules (MGrammar ms) = MGrammar $ reverse ms
-
-keepResModules :: Options -> SourceGrammar -> SourceGrammar
-keepResModules opts gr = 
-  if oElem retainOpers opts 
-    then MGrammar $ reverse [(i,mi) | (i,mi@(ModMod m)) <- modules gr, isModRes m]
-    else emptyMGrammar
-
-
--- | the environment
-type CompileEnv = (Int,SourceGrammar, GFC.CanonGrammar,EEnv)
-
-emptyCompileEnv :: TimedCompileEnv
-emptyCompileEnv = ((0,emptyMGrammar,emptyMGrammar,emptyEEnv),[])
-
-extendCompileEnvInt ((_,MGrammar ss, MGrammar cs,_),fts) (k,sm,cm) eenv ft = 
-  return ((k,MGrammar (sm:ss), MGrammar (cm:cs),eenv),ft++fts) --- reverse later
-
-extendCompileEnv e@((k,_,_,_),_) (sm,cm) = extendCompileEnvInt e (k,sm,cm)
-
-extendCompileEnvCanon ((k,s,c,e),fts) cgr eenv ft = 
-  return ((k,s, MGrammar (modules cgr ++ modules c),eenv),ft++fts)
-
-type TimedCompileEnv = (CompileEnv,[(String,(FilePath,ModTime))])
-
-compileOne :: Options -> TimedCompileEnv -> FullPath -> IOE TimedCompileEnv
-compileOne opts env@((_,srcgr,cancgr0,eenv),_) file = do
-
-  let putp = putPointE opts
-  let putpp = putPointEsil opts
-  let putpOpt v m act
-       | oElem beVerbose opts =  putp v act
-       | oElem beSilent opts  =  putpp v act
-       | otherwise = ioeIO (putStrFlush m) >> act
-
-  let gf   = takeExtensions file
-  let path = dropFileName file
-  let name = dropExtension file
-  let mos  = modules srcgr
-
-  case gf of
-    -- for multilingual canonical gf, just read the file and update environment
-    ".gfcm" -> do
-       cgr <- putp ("+ reading" +++ file) $ getCanonGrammar file
-       ft <- getReadTimes file
-       extendCompileEnvCanon env cgr eenv ft
-
-    -- for canonical gf, read the file and update environment, also source env
-    ".gfc" -> do
-       cm <- putp ("+ reading" +++ file) $ getCanonModule file
-       let cancgr = updateMGrammar (MGrammar [cm]) cancgr0 
-       sm <- ioeErr $ CG.canon2sourceModule $ unoptimizeCanonMod cancgr $ unSubelimModule cm
-       ft <- getReadTimes file
-       extendCompileEnv env (sm, cm) eenv ft
-
-    -- for compiled resource, parse and organize, then update environment
-    ".gfr" -> do
-       sm0 <- putp ("| reading" +++ file) $ getSourceModule opts file
-       let sm1 = unsubexpModule sm0
-       sm <- {- putp "creating indirections" $ -} ioeErr $ extendModule mos sm1
----- experiment with not optimizing gfr 
-----      sm:_  <- putp "  optimizing " $ ioeErr $ evalModule mos sm1
-       let gfc = gfcFile name 
-       cm  <- putp ("+ reading" +++ gfc) $ getCanonModule gfc
-       ft  <- getReadTimes file
-       extendCompileEnv env (sm,cm) eenv ft
-
-    -- for gf source, do full compilation
-
-    _ -> do
-
-      --- hack fix to a bug in ReadFiles with reused concrete
-
-      let modu = dropExtension file
-      b1 <- ioeIO $ doesFileExist file
-      b2 <- ioeIO $ doesFileExist $ gfrFile modu
-      if not b1
-        then if b2 
-          then compileOne opts env $ gfrFile $ modu 
-          else compileOne opts env $ gfcFile $ modu 
-        else do
-
-       sm0 <- putpOpt ("- parsing" +++ file) ("- compiling" +++ file ++ "... ") $ 
-                                           getSourceModule opts file
-       (k',sm,eenv')  <- makeSourceModule opts (fst env) sm0
-       cm  <- putpp "  generating code... " $ generateModuleCode opts path sm
-       ft <- getReadTimes file
-
-       sm':_ <- case snd sm of
-----         ModMod n | isModRes n -> putp "  optimizing " $ ioeErr $ evalModule mos sm
-         _ -> return [sm]
-
-       extendCompileEnvInt env (k',sm',cm) eenv' ft
-
--- | dispatch reused resource at early stage
-makeSourceModule :: Options -> CompileEnv -> 
-                    SourceModule -> IOE (Int,SourceModule,EEnv)
-makeSourceModule opts env@(k,gr,can,eenv) mo@(i,mi) = case mi of
-
-  ModMod m -> case mtype m of
-    MTReuse c -> do
-      sm <- ioeErr $ makeReuse gr i (extend m) c
-      let mo2 = (i, ModMod sm)
-          mos = modules gr
-      --- putp "  type checking reused" $ ioeErr $ showCheckModule mos mo2
-      return $ (k,mo2,eenv)
-{- ---- obsolete
-    MTUnion ty imps -> do
-      mo' <- ioeErr $ makeUnion gr i ty imps
-      compileSourceModule opts env mo'
--}
-
-    _ -> compileSourceModule opts env mo
-  _ -> compileSourceModule opts env mo
- where
-   putp = putPointE opts
-
-compileSourceModule :: Options -> CompileEnv -> 
-                       SourceModule -> IOE (Int,SourceModule,EEnv)
-compileSourceModule opts env@(k,gr,can,eenv) mo@(i,mi) = do
-
-  let putp  = putPointE opts
-      putpp = putPointEsil opts
-      mos   = modules gr
-
-  if (oElem showOld opts && oElem emitCode opts) 
-    then do
-      let (file,out) = (gfFile (prt i), prGrammar (MGrammar [mo]))
-      putp ("  wrote file" +++ file) $ ioeIO $ writeFile file out
-    else return ()
-
-  mo1   <- ioeErr $ rebuildModule mos mo
-
-  mo1b  <- ioeErr $ extendModule mos mo1
-
-  case mo1b of
-    (_,ModMod n) | not (isCompleteModule n) -> do
-      return (k,mo1b,eenv)   -- refresh would fail, since not renamed
-    _ -> do
-      mo2:_ <- putpp "  renaming " $ ioeErr $ renameModule mos mo1b
-
-      (mo3:_,warnings) <- putpp "  type checking" $ ioeErr $ showCheckModule mos mo2
-      if null warnings then return () else putp warnings $ return ()
-
-      (k',mo3r:_) <- putpp "  refreshing " $ ioeErr $ refreshModule (k,mos) mo3
-
-      (mo4,eenv') <- 
-        ---- if oElem "check_only" opts 
-          putpp "  optimizing " $ ioeErr $ optimizeModule opts (mos,eenv) mo3r
-      return (k',mo4,eenv')
- where
-   ----   prDebug mo = ioeIO $ putStrLn $ prGrammar $ MGrammar [mo] ---- debug
-   prDebug mo = ioeIO $ print $ length $ lines $ prGrammar $ MGrammar [mo]
-
-generateModuleCode :: Options -> InitPath -> SourceModule -> IOE GFC.CanonModule
-generateModuleCode opts path minfo@(name,info) = do
-
---- DEPREC
----  if oElem (iOpt "gfcc") opts
----    then ioeIO $ putStrLn $ prGrammar2gfcc minfo
----    else return ()
-
-  let pname = path </> prt name
-  minfo0     <- ioeErr $ redModInfo minfo
-  let oopts  = addOptions opts (iOpts (flagsModule minfo))
-      optims = maybe "all_subs" id $ getOptVal oopts useOptimizer
-      optim  = takeWhile (/='_') optims
-      subs   = drop 1 (dropWhile (/='_') optims) == "subs"
-  minfo1     <- return $ 
-    case optim of
-      "parametrize" -> shareModule paramOpt minfo0  -- parametrization and sharing
-      "values"      -> shareModule valOpt minfo0    -- tables as courses-of-values
-      "share"       -> shareModule shareOpt minfo0  -- sharing of branches
-      "all"         -> shareModule allOpt minfo0    -- first parametrize then values
-      "none"        -> minfo0                       -- no optimization
-      _             -> shareModule shareOpt minfo0  -- sharing; default
-
-  -- do common subexpression elimination if required by flag "subs"
-  minfo' <- 
-    if subs
-      then ioeErr $ elimSubtermsMod minfo1
-      else return minfo1
-
-  -- for resource, also emit gfr. 
-  --- Also for incomplete, to create timestamped gfc/gfr files
-  case info of
-    ModMod m | emitsGFR m && emit && nomulti -> do
-      let rminfo = if isCompilable info 
-                   then subexpModule minfo 
-                   else (name, ModMod emptyModule) 
-      let (file,out) = (gfrFile pname, prGrammar (MGrammar [rminfo]))
-      putp ("  wrote file" +++ file) $ ioeIO $ writeFile file $ compactPrint out
-    _ -> return ()
-  let encode = case getOptVal opts uniCoding of
-        Just "utf8" -> encodeUTF8
-        _ -> id
-  (file,out) <- do
-      code <- return $ MkGFC.prCanonModInfo minfo'
-      return (gfcFile pname, encode code)
-  if emit && nomulti ---- && isCompilable info 
-     then putp  ("  wrote file" +++ file) $ ioeIO $ writeFile file out
-     else putpp ("no need to save module" +++ prt name) $ return ()
-  return minfo'
- where 
-   putp  = putPointE opts
-   putpp = putPointEsil opts
-
-   emitsGFR m = isModRes m ---- && isCompilable info
-     ---- isModRes m || (isModCnc m && mstatus m == MSIncomplete)
-   isCompilable mi = case mi of
-     ModMod m -> not $ isModCnc m && mstatus m == MSIncomplete 
-     _ -> True
-   nomulti = not $ oElem makeMulti opts
-   emit  = oElem emitCode opts && not (oElem notEmitCode opts)
-
--- for old GF: sort into modules, write files, compile as usual
-
-compileOld :: Options -> FilePath -> IOE GFC.CanonGrammar
-compileOld opts file = do
-  let putp = putPointE opts
-  grammar1 <- putp ("- parsing old gf" +++ file) $ getOldGrammar opts file
-  files <- mapM writeNewGF $ modules grammar1
-  ((_,_,grammar,_),_) <- foldM (compileOne opts) emptyCompileEnv files
-  return grammar
-
-writeNewGF :: SourceModule -> IOE FilePath
-writeNewGF m@(i,_) = do
-  let file = gfFile $ prt i
-  ioeIO $ writeFile file $ prGrammar (MGrammar [m])
-  ioeIO $ putStrLn $ "wrote file" +++ file
-  return file
-
---- this function duplicates a lot of code from compileModule.
---- It does not really belong here either.
--- It selects those .gfe files that a grammar depends on and that
--- are younger than corresponding gf
-
-getGFEFiles :: Options -> FilePath -> IO [FilePath]
-getGFEFiles opts1 file = useIOE [] $ do
-  opts0 <- ioeIO $ getOptionsFromFile file
-  let useFileOpt = maybe False (const True) $ getOptVal opts0 pathList
-  let useLineOpt = maybe False (const True) $ getOptVal opts1 pathList
-  let opts = addOptions opts1 opts0 
-  let fpath = dropFileName file
-  ps0 <- ioeIO $ pathListOpts opts fpath
-
-  let ps1 = if (useFileOpt && not useLineOpt) 
-              then (map (combine fpath) ps0)
-              else ps0
-  ps <- ioeIO $ extendPathEnv ps1
-  let file' = if useFileOpt then takeFileName file else file -- to find file itself
-  files <- getAllFiles opts ps [] file'
-  efiles <- ioeIO $ filterM doesFileExist [replaceExtension f "gfe" | f <- files]
-  es <- ioeIO $ mapM (uncurry selectLater) [(f, init f) | f <- efiles] -- init gfe == gf
-  return $ filter ((=='e') . last) es