summaryrefslogtreecommitdiff
path: root/src/GF/Devel/Compile/Compile.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/GF/Devel/Compile/Compile.hs')
-rw-r--r--src/GF/Devel/Compile/Compile.hs205
1 files changed, 0 insertions, 205 deletions
diff --git a/src/GF/Devel/Compile/Compile.hs b/src/GF/Devel/Compile/Compile.hs
deleted file mode 100644
index 07e059ed4..000000000
--- a/src/GF/Devel/Compile/Compile.hs
+++ /dev/null
@@ -1,205 +0,0 @@
-module GF.Devel.Compile.Compile (batchCompile) where
-
--- the main compiler passes
-import GF.Devel.Compile.GetGrammar
-import GF.Devel.Compile.Extend
-import GF.Devel.Compile.Rename
-import GF.Devel.Compile.CheckGrammar
-import GF.Devel.Compile.Refresh
-import GF.Devel.Compile.Optimize
-import GF.Devel.Compile.Factorize
-
-import GF.Devel.Grammar.Grammar
-import GF.Devel.Grammar.Construct
-import GF.Infra.Ident
-import GF.Devel.Grammar.PrGF
-----import GF.Devel.Grammar.Lookup
-import GF.Devel.Infra.ReadFiles
-
-import GF.Infra.Option ----
-import GF.Data.Operations
-import GF.Devel.UseIO
-import GF.Devel.Arch
-
-import Control.Monad
-import System.Directory
-
-batchCompile :: Options -> [FilePath] -> IO GF
-batchCompile opts files = do
- let defOpts = addOptions opts (options [emitCode])
- egr <- appIOE $ foldM (compileModule defOpts) emptyCompileEnv files
- case egr of
- Ok (_,gr) -> return gr
- Bad s -> error s
-
--- to output an intermediate stage
-intermOut :: Options -> Option -> String -> IOE ()
-intermOut opts opt s =
- if oElem opt opts || oElem (iOpt "show_all") opts
- then
- ioeIO (putStrLn ("\n\n--#" +++ prOpt opt) >> putStrLn s)
- else
- return ()
-
-prMod :: SourceModule -> String
-prMod = prModule
-
--- | the environment
-type CompileEnv = (Int,GF)
-
--- | 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 -> CompileEnv -> FilePath -> IOE CompileEnv
-compileModule opts1 env 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 sgr = snd env
- let rfs = [] ---- files already in memory and their read times
- let file' = if useFileOpt then takeFileName file else file -- 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 sgr2 = sgr ----MGrammar [m | m@(i,_) <- modules sgr,
- ---- notElem (prt i) $ map dropExtension names]
- let env0 = (0,sgr2)
- (e,mm) <- foldIOE (compileOne opts) env0 files
- maybe (return ()) putStrLnE mm
- return e
-
-
-compileOne :: Options -> CompileEnv -> FullPath -> IOE CompileEnv
-compileOne opts env@(_,srcgr) file = do
-
- let putp s = putPointE opts ("\n" ++ s)
- let putpp = putPointEsil opts
- let putpOpt v m act
- | oElem beVerbose opts = putp v act
- | oElem beSilent opts = putpp v act
- | otherwise = ioeIO (putStrFlush ("\n" ++ m)) >> act
-
- let gf = takeExtensions file
- let path = dropFileName file
- let name = dropExtension file
- let mos = gfmodules srcgr
-
- case gf of
-
- -- for compiled gf, read the file and update environment
- -- also undo common subexp optimization, to enable normal computations
-
- ".gfn" -> do
- sm0 <- putp ("+ reading" +++ file) $ getSourceModule opts file
- let sm1 = unsubexpModule sm0
- sm <- {- putp "creating indirections" $ -} ioeErr $ extendModule srcgr sm1
- extendCompileEnv env sm
-
- -- for gf source, do full compilation and generate code
- _ -> do
-
- let modu = dropExtension file
- b1 <- ioeIO $ doesFileExist file
- if not b1
- then compileOne opts env $ gfoFile $ modu
- else do
-
- sm0 <-
- putpOpt ("- parsing" +++ file) ("- compiling" +++ file ++ "... ") $
- getSourceModule opts file
- (k',sm) <- compileSourceModule opts env sm0
- let sm1 = sm ----
----- if isConcr sm then shareModule sm else sm -- cannot expand Str
- if oElem (iOpt "doemit") opts
- then putpp " generating code... " $ generateModuleCode opts path sm1
- else return ()
----- -- sm is optimized before generation, but not in the env
----- let cm2 = unsubexpModule cm
- extendCompileEnvInt env (k',sm) ---- sm1
- where
- isConcr (_,mi) = case mi of
----- ModMod m -> isModCnc m && mstatus m /= MSIncomplete
- _ -> False
-
-
-
-compileSourceModule :: Options -> CompileEnv ->
- SourceModule -> IOE (Int,SourceModule)
-compileSourceModule opts env@(k,gr) mo@(i,mi) = do
-
- intermOut opts (iOpt "show_gf") (prMod mo)
-
- let putp = putPointE opts
- putpp = putPointEsil opts
- stopIf n comp m =
- if any (\k -> oElem (iOpt (show k)) opts) [1..n] then return m else comp m
- stopIfV v n comp m =
- if any (\k -> oElem (iOpt (show k)) opts) [1..n] then return (m,v) else comp m
-
- moe <- stopIf 1 (putpp " extending" . ioeErr . extendModule gr) mo
- intermOut opts (iOpt "show_extend") (prMod moe)
-
- mor <- stopIf 2 (putpp " renaming" . ioeErr . renameModule gr) moe
- intermOut opts (iOpt "show_rename") (prMod mor)
-
- (moc,warnings) <-
- stopIfV [] 3 (putpp " type checking" . ioeErr . showCheckModule gr) mor
- if null warnings then return () else putp warnings $ return ()
- intermOut opts (iOpt "show_typecheck") (prMod moc)
-
- (mox,k') <- stopIfV k 4 (putpp " refreshing " . ioeErr . refreshModule k) moc
- intermOut opts (iOpt "show_refresh") (prMod mox)
-
- moo <- stopIf 5 (putpp " optimizing " . ioeErr . optimizeModule opts gr) mox
- intermOut opts (iOpt "show_optimize") (prMod moo)
-
- mof <- stopIf 6 (putpp " factorizing " . ioeErr . optimizeModule opts gr) moo
- intermOut opts (iOpt "show_factorize") (prMod mof)
-
- return (k',moo) ----
-
-
-generateModuleCode :: Options -> InitPath -> SourceModule -> IOE ()
-generateModuleCode opts path minfo@(name,info) = do
-
- let pname = combine path (prt name)
- let minfo0 = minfo
- let minfo1 = subexpModule minfo0
- let minfo2 = minfo1
-
- 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
-
-pathListOpts :: Options -> FileName -> IO [InitPath]
-pathListOpts opts file = return $ maybe [file] splitInModuleSearchPath $ getOptVal opts pathList
-
-----reverseModules (MGrammar ms) = MGrammar $ reverse ms
-
-emptyCompileEnv :: CompileEnv
-emptyCompileEnv = (0,emptyGF)
-
-extendCompileEnvInt (_,gf) (k,(s,m)) = return (k, addModule s m gf)
-
-extendCompileEnv e@(k,_) sm = extendCompileEnvInt e (k,sm)
-
-
generated by cgit v1.2.3 (git 2.39.1) at 2026-05-20 06:08:45 +0000