X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FHscMain.lhs;h=3a20b5bbf3e5d42548625db213c7f9d43a729259;hb=7fc749a43b4b6b85d234fa95d4928648259584f4;hp=1abdbdc5385e2a0d5a77e403b5c643768cf210d9;hpb=f071ec8860dc3be9329808b8d41008c353dc91e8;p=ghc-hetmet.git diff --git a/compiler/main/HscMain.lhs b/compiler/main/HscMain.lhs index 1abdbdc..3a20b5b 100644 --- a/compiler/main/HscMain.lhs +++ b/compiler/main/HscMain.lhs @@ -5,6 +5,13 @@ \section[GHC_Main]{Main driver for Glasgow Haskell compiler} \begin{code} +{-# OPTIONS -w #-} +-- The above warning supression flag is a temporary kludge. +-- While working on this module you are encouraged to remove it and fix +-- any warnings in the module. See +-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings +-- for details + module HscMain ( newHscEnv, hscCmmFile , hscFileCheck @@ -33,7 +40,6 @@ import CoreSyn ( CoreExpr ) import CoreTidy ( tidyExpr ) import CorePrep ( corePrepExpr ) import Flattening ( flattenExpr ) -import Vectorise ( vectorise ) import Desugar ( deSugarExpr ) import SimplCore ( simplifyExpr ) import TcRnDriver ( tcRnStmt, tcRnExpr, tcRnType ) @@ -54,7 +60,7 @@ import HsSyn ( HsModule, LHsBinds, HsGroup, LIE, LImportDecl, HsDoc, HaddockModInfo ) import CoreSyn import SrcLoc ( Located(..) ) -import StringBuffer ( hGetStringBuffer, stringToStringBuffer ) +import StringBuffer import Parser import Lexer import SrcLoc ( mkSrcLoc ) @@ -67,7 +73,6 @@ import PrelInfo ( wiredInThings, basicKnownKeyNames ) import MkIface ( checkOldIface, mkIface, writeIfaceFile ) import Desugar ( deSugar ) import Flattening ( flatten ) -import Vectorise ( vectorise ) import SimplCore ( core2core ) import TidyPgm ( tidyProgram, mkBootModDetails ) import CorePrep ( corePrepPgm ) @@ -478,13 +483,11 @@ hscSimplify :: ModGuts -> Comp ModGuts hscSimplify ds_result = do hsc_env <- gets compHscEnv liftIO $ do - vect_result <- {-# SCC "Vectorisation" #-} - vectorise hsc_env ds_result ------------------- -- SIMPLIFY ------------------- simpl_result <- {-# SCC "Core2Core" #-} - core2core hsc_env vect_result + core2core hsc_env ds_result return simpl_result -------------------------------------------------------------- @@ -605,10 +608,10 @@ hscCompile cgguts ------------------ Code generation ------------------ abstractC <- {-# SCC "CodeGen" #-} codeGen dflags this_mod data_tycons - foreign_stubs dir_imps cost_centre_info + dir_imps cost_centre_info stg_binds hpc_info ------------------ Convert to CPS -------------------- - --continuationC <- cmmCPS dflags abstractC + --continuationC <- cmmCPS dflags abstractC >>= cmmToRawCmm continuationC <- cmmToRawCmm abstractC ------------------ Code output ----------------------- (stub_h_exists,stub_c_exists) @@ -675,7 +678,7 @@ hscFileCheck hsc_env mod_summary compileToCore = do { -- RENAME and TYPECHECK ------------------- (tc_msgs, maybe_tc_result) - <- _scc_ "Typecheck-Rename" + <- {-# SCC "Typecheck-Rename" #-} tcRnModule hsc_env (ms_hsc_src mod_summary) True{-save renamed syntax-} rdr_module @@ -694,8 +697,7 @@ hscFileCheck hsc_env mod_summary compileToCore = do { md_rules = [panic "no rules"], -- Rules are CoreRules, not the -- RuleDecls we get out of the typechecker - md_vect_info = - panic "HscMain.hscFileCheck: no VectInfo" + md_vect_info = noVectInfo -- VectInfo is added by the Core -- vectorisation pass } @@ -725,7 +727,7 @@ hscCmmFile dflags filename = do case maybe_cmm of Nothing -> return False Just cmm -> do - --continuationC <- cmmCPS dflags [cmm] + --continuationC <- cmmCPS dflags [cmm] >>= cmmToRawCmm continuationC <- cmmToRawCmm [cmm] codeOutput dflags no_mod no_loc NoStubs [] continuationC return True @@ -736,6 +738,8 @@ hscCmmFile dflags filename = do ml_obj_file = panic "hscCmmFile: no obj file" } +myParseModule :: DynFlags -> FilePath -> Maybe StringBuffer + -> IO (Either ErrMsg (Located (HsModule RdrName))) myParseModule dflags src_filename maybe_src_buf = -------------------------- Parser ---------------- showPass dflags "Parser" >>