X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FHscMain.lhs;h=fec3f6cb6b3b0b172501ceb715819555b83735e0;hb=9f68c34843602e815e71ef68f43adc01da993672;hp=03daf341499f8d01005f3b0568c20db29182fb1e;hpb=8d48737f404f079a3deec1c00c86aa028a124efb;p=ghc-hetmet.git

diff --git a/compiler/main/HscMain.lhs b/compiler/main/HscMain.lhs
index 03daf34..fec3f6c 100644
--- a/compiler/main/HscMain.lhs
+++ b/compiler/main/HscMain.lhs
@@ -112,10 +112,11 @@ import LazyUniqFM		( emptyUFM )
 import UniqSupply       ( initUs_ )
 import Bag		( unitBag )
 import Exception
-import MonadUtils
+-- import MonadUtils
 
 import Control.Monad
-import System.IO
+import Control.Concurrent.MVar ( newMVar )
+-- import System.IO
 import Data.IORef
 \end{code}
 #include "HsVersions.h"
@@ -133,6 +134,7 @@ newHscEnv callbacks dflags
   = 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
@@ -144,6 +146,7 @@ newHscEnv callbacks dflags
 			   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,
@@ -229,12 +232,13 @@ hscTypecheckRename mod_summary rdr_module = do
           <- {-# SCC "Typecheck-Rename" #-}
              ioMsgMaybe $ tcRnModule hsc_env (ms_hsc_src mod_summary) True rdr_module
 
-    let rn_info = do decl <- tcg_rn_decls tc_result
-                     imports <- tcg_rn_imports tc_result
-                     let exports = tcg_rn_exports tc_result
-                     let doc = tcg_doc tc_result
-        	     let hmi = tcg_hmi tc_result
-                     return (decl,imports,exports,doc,hmi)
+    let -- This 'do' is in the Maybe monad!
+        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) }
 
     return (tc_result, rn_info)
 
@@ -717,10 +721,11 @@ hscGenHardCode cgguts mod_summary
                                stg_binds hpc_info
 
          --- Optionally run experimental Cmm transformations ---
-         cmms <- optionallyConvertAndOrCPS hsc_env cmms
+         -- cmms <- optionallyConvertAndOrCPS hsc_env cmms
                  -- unless certain dflags are on, the identity function
          ------------------  Code output -----------------------
          rawcmms <- cmmToRawCmm cmms
+         dumpIfSet_dyn dflags Opt_D_dump_cmmz "Raw Cmm" (ppr rawcmms)
          (_stub_h_exists, stub_c_exists)
              <- codeOutput dflags this_mod location foreign_stubs 
                 dependencies rawcmms
@@ -772,7 +777,7 @@ hscCmmFile hsc_env filename = do
              parseCmmFile dflags filename
     cmms <- liftIO $ optionallyConvertAndOrCPS hsc_env [cmm]
     rawCmms <- liftIO $ cmmToRawCmm cmms
-    liftIO $ codeOutput dflags no_mod no_loc NoStubs [] rawCmms
+    _ <- liftIO $ codeOutput dflags no_mod no_loc NoStubs [] rawCmms
     return ()
   where
 	no_mod = panic "hscCmmFile: no_mod"
@@ -811,10 +816,8 @@ tryNewCodeGen hsc_env this_mod data_tycons imported_mods
 	; prog <- return $ map (runTx $ runCmmOpts cmmCfgOptsZ) (srtToData topSRT : prog)
 		-- Control flow optimisation, again
 
-	; dumpIfSet_dyn dflags Opt_D_dump_cmmz "Output Cmm" (pprCmms prog)
-
 	; let prog' = map cmmOfZgraph prog
-	; dumpIfSet_dyn dflags Opt_D_dump_cmmz "Raw Cmm" (ppr prog')
+	; dumpIfSet_dyn dflags Opt_D_dump_cmmz "Output Cmm" (ppr prog')
 	; return prog' }
 
 
@@ -853,7 +856,6 @@ testCmmConversion hsc_env cmm =
        let cvt = cmmOfZgraph $ cfopts $ chosen_graph
        dumpIfSet_dyn dflags Opt_D_dump_cvt_cmm "C-- post-conversion" (ppr cvt)
        return cvt
-       -- return cmm -- don't use the conversion
 
 myCoreToStg :: DynFlags -> Module -> [CoreBind]
             -> IO ( [(StgBinding,[(Id,[Id])])]  -- output program