projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Bottom extraction: float out bottoming expressions to top level
[ghc-hetmet.git]
/
compiler
/
main
/
HscMain.lhs
diff --git
a/compiler/main/HscMain.lhs
b/compiler/main/HscMain.lhs
index
fec3f6c
..
9c21d0a
100644
(file)
--- a/
compiler/main/HscMain.lhs
+++ b/
compiler/main/HscMain.lhs
@@
-115,7
+115,6
@@
import Exception
-- import MonadUtils
import Control.Monad
-- import MonadUtils
import Control.Monad
-import Control.Concurrent.MVar ( newMVar )
-- import System.IO
import Data.IORef
\end{code}
-- import System.IO
import Data.IORef
\end{code}
@@
-134,7
+133,6
@@
newHscEnv callbacks dflags
= do { eps_var <- newIORef initExternalPackageState
; us <- mkSplitUniqSupply 'r'
; nc_var <- newIORef (initNameCache us knownKeyNames)
= do { eps_var <- newIORef initExternalPackageState
; us <- mkSplitUniqSupply 'r'
; nc_var <- newIORef (initNameCache us knownKeyNames)
- ; nc_lock <- newMVar ()
; fc_var <- newIORef emptyUFM
; mlc_var <- newIORef emptyModuleEnv
; optFuel <- initOptFuelState
; fc_var <- newIORef emptyUFM
; mlc_var <- newIORef emptyModuleEnv
; optFuel <- initOptFuelState
@@
-146,7
+144,6
@@
newHscEnv callbacks dflags
hsc_HPT = emptyHomePackageTable,
hsc_EPS = eps_var,
hsc_NC = nc_var,
hsc_HPT = emptyHomePackageTable,
hsc_EPS = eps_var,
hsc_NC = nc_var,
- hsc_NC_lock = nc_lock,
hsc_FC = fc_var,
hsc_MLC = mlc_var,
hsc_OptFuel = optFuel,
hsc_FC = fc_var,
hsc_MLC = mlc_var,
hsc_OptFuel = optFuel,
@@
-186,7
+183,7
@@
hscParse mod_summary = do
Just b -> return b
Nothing -> liftIO $ hGetStringBuffer src_filename
Just b -> return b
Nothing -> liftIO $ hGetStringBuffer src_filename
- let loc = mkSrcLoc (mkFastString src_filename) 1 0
+ let loc = mkSrcLoc (mkFastString src_filename) 1 1
case unP parseModule (mkPState buf loc dflags) of
PFailed span err ->
case unP parseModule (mkPState buf loc dflags) of
PFailed span err ->
@@
-219,7
+216,7
@@
hscTypecheck mod_summary rdr_module = do
-- exception/signal an error.
type RenamedStuff =
(Maybe (HsGroup Name, [LImportDecl Name], Maybe [LIE Name],
-- exception/signal an error.
type RenamedStuff =
(Maybe (HsGroup Name, [LImportDecl Name], Maybe [LIE Name],
- Maybe (HsDoc Name), HaddockModInfo Name))
+ Maybe LHsDocString))
-- | Rename and typecheck a module, additionally returning the renamed syntax
hscTypecheckRename ::
-- | Rename and typecheck a module, additionally returning the renamed syntax
hscTypecheckRename ::
@@
-236,9
+233,8
@@
hscTypecheckRename mod_summary rdr_module = do
rn_info = do { decl <- tcg_rn_decls tc_result
; let imports = tcg_rn_imports tc_result
exports = tcg_rn_exports tc_result
rn_info = do { decl <- tcg_rn_decls tc_result
; let imports = tcg_rn_imports tc_result
exports = tcg_rn_exports tc_result
- doc = tcg_doc tc_result
- hmi = tcg_hmi tc_result
- ; return (decl,imports,exports,doc,hmi) }
+ doc_hdr = tcg_doc_hdr tc_result
+ ; return (decl,imports,exports,doc_hdr) }
return (tc_result, rn_info)
return (tc_result, rn_info)
@@
-793,11
+789,8
@@
tryNewCodeGen :: HscEnv -> Module -> [TyCon] -> [Module]
-> HpcInfo
-> IO [Cmm]
tryNewCodeGen hsc_env this_mod data_tycons imported_mods
-> HpcInfo
-> IO [Cmm]
tryNewCodeGen hsc_env this_mod data_tycons imported_mods
- cost_centre_info stg_binds hpc_info
- | not (dopt Opt_TryNewCodeGen (hsc_dflags hsc_env))
- = return []
- | otherwise
- = do { let dflags = hsc_dflags hsc_env
+ cost_centre_info stg_binds hpc_info =
+ do { let dflags = hsc_dflags hsc_env
; prog <- StgCmm.codeGen dflags this_mod data_tycons imported_mods
cost_centre_info stg_binds hpc_info
; dumpIfSet_dyn dflags Opt_D_dump_cmmz "Cmm produced by new codegen"
; prog <- StgCmm.codeGen dflags this_mod data_tycons imported_mods
cost_centre_info stg_binds hpc_info
; dumpIfSet_dyn dflags Opt_D_dump_cmmz "Cmm produced by new codegen"
@@
-806,8
+799,8
@@
tryNewCodeGen hsc_env this_mod data_tycons imported_mods
; prog <- return $ map (runTx $ runCmmOpts cmmCfgOptsZ) prog
-- Control flow optimisation
; prog <- return $ map (runTx $ runCmmOpts cmmCfgOptsZ) prog
-- Control flow optimisation
- -- Note: Have to thread the module's SRT through all the procedures
- -- because we greedily build it as we go.
+ -- We are building a single SRT for the entire module, so
+ -- we must thread it through all the procedures as we cps-convert them.
; us <- mkSplitUniqSupply 'S'
; let topSRT = initUs_ us emptySRT
; (topSRT, prog) <- foldM (protoCmmCPSZ hsc_env) (topSRT, []) prog
; us <- mkSplitUniqSupply 'S'
; let topSRT = initUs_ us emptySRT
; (topSRT, prog) <- foldM (protoCmmCPSZ hsc_env) (topSRT, []) prog
@@
-991,7
+984,7
@@
hscParseThing parser dflags str
buf <- liftIO $ stringToStringBuffer str
buf <- liftIO $ stringToStringBuffer str
- let loc = mkSrcLoc (fsLit "<interactive>") 1 0
+ let loc = mkSrcLoc (fsLit "<interactive>") 1 1
case unP parser (mkPState buf loc dflags) of
case unP parser (mkPState buf loc dflags) of