diff options
Diffstat (limited to 'src/GF/Source/CompileM.hs')
| -rw-r--r-- | src/GF/Source/CompileM.hs | 141 |
1 files changed, 0 insertions, 141 deletions
diff --git a/src/GF/Source/CompileM.hs b/src/GF/Source/CompileM.hs deleted file mode 100644 index 3d97a029e..000000000 --- a/src/GF/Source/CompileM.hs +++ /dev/null @@ -1,141 +0,0 @@ -module CompileM where - -import Grammar -import Ident -import Option -import PrGrammar -import Update -import Lookup -import Modules ----import Rename - -import Operations -import UseIO - -import Monad - -compileMGrammar :: Options -> SourceGrammar -> IOE SourceGrammar -compileMGrammar opts sgr = do - - ioeErr $ checkUniqueModuleNames sgr - - deps <- ioeErr $ moduleDeps sgr - - deplist <- either return - (\ms -> ioeBad $ "circular modules" +++ unwords (map show ms)) $ - topoTest deps - - let deps' = closureDeps deps - - foldM (compileModule opts deps' sgr) emptyMGrammar deplist - -checkUniqueModuleNames :: MGrammar i f a r c -> Err () -checkUniqueModuleNames gr = do - let ms = map fst $ tree2list $ modules gr - msg = checkUnique ms - if null msg then return () else Bad $ unlines msg - --- to decide what modules immediately depend on what, and check if the --- dependencies are appropriate - -moduleDeps :: MGrammar i f a c r -> Err Dependencies -moduleDeps gr = mapM deps $ tree2list $ modules gr where - deps (c,mi) = errIn ("checking dependencies of module" +++ prt c) $ case mi of - ModAbs m -> chDep (IdentM c MTAbstract) - (extends m) MTAbstract (opens m) MTAbstract - ModRes m -> chDep (IdentM c MTResource) - (extends m) MTResource (opens m) MTResource - ModCnc m -> do - a:ops <- case opens m of - os@(_:_) -> return os - _ -> Bad "no abstract indicated for concrete module" - aty <- lookupModuleType gr a - testErr (aty == MTAbstract) "the for-module is not an abstract syntax" - chDep (IdentM c (MTConcrete a)) (extends m) MTResource ops MTResource - - chDep it es ety os oty = do - ests <- mapM (lookupModuleType gr) es - testErr (all (==ety) ests) "inappropriate extension module type" - osts <- mapM (lookupModuleType gr) os - testErr (all (==oty) osts) "inappropriate open module type" - return (it, [IdentM e ety | e <- es] ++ [IdentM o oty | o <- os]) - -type Dependencies = [(IdentM Ident,[IdentM Ident])] - ----compileModule :: Options -> Dependencies -> SourceGrammar -> ---- CanonGrammar -> IdentM -> IOE CanonGrammar -compileModule opts deps sgr cgr i = do - - let name = identM i - - testIfCompiled deps name - - mi <- ioeErr $ lookupModule sgr name - - mi' <- case typeM i of - -- previously compiled cgr used as symbol table - MTAbstract -> compileAbstract cgr mi - MTResource -> compileResource cgr mi - MTConcrete a -> compileConcrete a cgr mi - - ifIsOpt doOutput $ writeCanonFile name mi' - - return $ addModule cgr name mi' - - where - - ifIsOpt o f = if (oElem o opts) then f else return () - doOutput = iOpt "o" - - -testIfCompiled :: Dependencies -> Ident -> IOE Bool -testIfCompiled _ _ = return False ---- - ----writeCanonFile :: Ident -> CanonModInfo -> IOE () -writeCanonFile name mi' = ioeIO $ writeFile (canonFileName name) [] ---- - -canonFileName n = n ++ ".gfc" ---- elsewhere! - ----compileAbstract :: CanonGrammar -> SourceModInfo -> IOE CanonModInfo -compileAbstract can (ModAbs m0) = do - let m1 = renameMAbstract m0 -{- - checkUnique - typeCheck - generateCode - addToCanon --} - ioeBad "compile abs not yet" - ----compileResource :: CanonGrammar -> SourceModInfo -> IOE CanonModInfo -compileResource can md = do -{- - checkUnique - typeCheck - topoSort - compileOpers -- conservative, since more powerful than lin - generateCode - addToCanon --} - ioeBad "compile res not yet" - ----compileConcrete :: Ident -> CanonGrammar -> SourceModInfo -> IOE CanonModInfo -compileConcrete ab can md = do -{- - checkUnique - checkComplete ab - typeCheck - topoSort - compileOpers - optimize - createPreservedOpers - generateCode - addToCanon --} - ioeBad "compile cnc not yet" - - --- to be imported - -closureDeps :: [(a,[a])] -> [(a,[a])] -closureDeps ds = ds ---- fix-point iteration |
