\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
HaddockModInfo )
import CoreSyn
import SrcLoc ( Located(..) )
-import StringBuffer ( hGetStringBuffer, stringToStringBuffer )
+import StringBuffer
import Parser
import Lexer
import SrcLoc ( mkSrcLoc )
import CodeGen ( codeGen )
import CmmParse ( parseCmmFile )
import CmmCPS
+import CmmInfo
import CodeOutput ( codeOutput )
import NameEnv ( emptyNameEnv )
-- Compilers
--------------------------------------------------------------
--- 1 2 3 4 5 6 7 8 9
-- Compile Haskell, boot and extCore in OneShot mode.
hscCompileOneShot :: Compiler HscStatus
-hscCompileOneShot = hscCompileHardCode norecompOneShot oneShotMsg hscOneShot (hscConst (HscRecomp False))
+hscCompileOneShot
+ = hscCompiler norecompOneShot oneShotMsg backend boot_backend
+ where
+ backend inp = hscSimplify inp >>= hscNormalIface >>= hscWriteIface >>= hscOneShot
+ boot_backend inp = hscSimpleIface inp >>= hscWriteIface >> return (HscRecomp False)
-- Compile Haskell, boot and extCore in batch mode.
hscCompileBatch :: Compiler (HscStatus, ModIface, ModDetails)
-hscCompileBatch = hscCompileHardCode norecompBatch batchMsg hscBatch hscNothing
-
--- Compile to hardcode (C,asm,...). This general structure is shared by OneShot and Batch.
-hscCompileHardCode :: NoRecomp result -- No recomp necessary
- -> (Maybe (Int,Int) -> Bool -> Comp ()) -- Message callback
- -> ((ModIface, ModDetails, CgGuts) -> Comp result) -- Compile normal file
- -> ((ModIface, ModDetails, ModGuts) -> Comp result) -- Compile boot file
- -> Compiler result
-hscCompileHardCode norecomp msg compNormal compBoot hsc_env mod_summary =
- compiler hsc_env mod_summary
- where mkComp = hscMkCompiler norecomp msg
- -- How to compile nonBoot files.
- nonBootComp inp = hscSimplify inp >>= hscNormalIface >>=
- hscWriteIface >>= compNormal
- -- How to compile boot files.
- bootComp inp = hscSimpleIface inp >>= hscWriteIface >>= compBoot
- compiler
- = case ms_hsc_src mod_summary of
- ExtCoreFile
- -> mkComp hscCoreFrontEnd nonBootComp
- HsSrcFile
- -> mkComp hscFileFrontEnd nonBootComp
- HsBootFile
- -> mkComp hscFileFrontEnd bootComp
+hscCompileBatch
+ = hscCompiler norecompBatch batchMsg backend boot_backend
+ where
+ backend inp = hscSimplify inp >>= hscNormalIface >>= hscWriteIface >>= hscBatch
+ boot_backend inp = hscSimpleIface inp >>= hscWriteIface >>= hscNothing
-- Type-check Haskell, boot and extCore.
-- Does it make sense to compile extCore to nothing?
hscCompileNothing :: Compiler (HscStatus, ModIface, ModDetails)
-hscCompileNothing hsc_env mod_summary
- = compiler hsc_env mod_summary
- where mkComp = hscMkCompiler norecompBatch batchMsg
- pipeline inp = hscSimpleIface inp >>= hscIgnoreIface >>= hscNothing
- compiler
- = case ms_hsc_src mod_summary of
- ExtCoreFile
- -> mkComp hscCoreFrontEnd pipeline
- HsSrcFile
- -> mkComp hscFileFrontEnd pipeline
- HsBootFile
- -> mkComp hscFileFrontEnd pipeline
+hscCompileNothing
+ = hscCompiler norecompBatch batchMsg backend backend
+ where
+ backend inp = hscSimpleIface inp >>= hscIgnoreIface >>= hscNothing
-- Compile Haskell, extCore to bytecode.
hscCompileInteractive :: Compiler (InteractiveStatus, ModIface, ModDetails)
-hscCompileInteractive hsc_env mod_summary =
- hscMkCompiler norecompInteractive batchMsg
- frontend backend
- hsc_env mod_summary
- where backend inp = hscSimplify inp >>= hscNormalIface >>= hscIgnoreIface >>= hscInteractive
- frontend = case ms_hsc_src mod_summary of
- ExtCoreFile -> hscCoreFrontEnd
- HsSrcFile -> hscFileFrontEnd
- HsBootFile -> panic bootErrorMsg
- bootErrorMsg = "Compiling a HsBootFile to bytecode doesn't make sense. " ++
- "Use 'hscCompileBatch' instead."
+hscCompileInteractive
+ = hscCompiler norecompInteractive batchMsg backend boot_backend
+ where
+ backend inp = hscSimplify inp >>= hscNormalIface >>= hscIgnoreIface >>= hscInteractive
+ boot_backend = panic "hscCompileInteractive: can't do boot files here"
+
+hscCompiler
+ :: NoRecomp result -- No recomp necessary
+ -> (Maybe (Int,Int) -> Bool -> Comp ()) -- Message callback
+ -> (ModGuts -> Comp result) -- Compile normal file
+ -> (ModGuts -> Comp result) -- Compile boot file
+ -> Compiler result
+hscCompiler norecomp msg nonBootComp bootComp hsc_env mod_summary =
+ hscMkCompiler norecomp msg frontend backend hsc_env mod_summary
+ where
+ (frontend,backend)
+ = case ms_hsc_src mod_summary of
+ ExtCoreFile -> (hscCoreFrontEnd, nonBootComp)
+ HsSrcFile -> (hscFileFrontEnd, nonBootComp)
+ HsBootFile -> (hscFileFrontEnd, bootComp)
--------------------------------------------------------------
-- NoRecomp handlers
hscSimplify ds_result
= do hsc_env <- gets compHscEnv
liftIO $ do
- flat_result <- {-# SCC "Flattening" #-}
- flatten hsc_env ds_result
-------------------
-- SIMPLIFY
-------------------
simpl_result <- {-# SCC "Core2Core" #-}
- core2core hsc_env flat_result
+ core2core hsc_env ds_result
return simpl_result
--------------------------------------------------------------
------------------ 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)
<- codeOutput dflags this_mod location foreign_stubs
-- 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
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
}
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
where
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" >>
projects / ghc-hetmet.git / blobdiff