\begin{code}
module HscMain (
HscResult(..),
- hscMain, newHscEnv, hscCmmFile, hscBufferFrontEnd
+ hscMain, newHscEnv, hscCmmFile,
+ hscBufferCheck, hscFileCheck,
#ifdef GHCI
, hscStmt, hscTcExpr, hscKcType
, hscGetInfo, GetInfoResult
= HscFail
-- In IDE mode: we just do the static/dynamic checks
- | HscChecked
- (Located (HsModule RdrName)) -- parse tree
- (Maybe TcGblEnv) -- typechecker output, if succeeded
+ | HscChecked (Located (HsModule RdrName)) (Maybe TcGblEnv)
-- Concluded that it wasn't necessary
| HscNoRecomp ModDetails -- new details (HomeSymbolTable additions)
compilationProgressMsg dflags $
("Compiling " ++ showModMsg (not toInterp) mod location);
+ ; let hspp_file = expectJust "hscFrontEnd:hspp" (ml_hspp_file location)
; front_res <- if toCore then
- hscCoreFrontEnd hsc_env msg_act location
+ hscCoreFrontEnd hsc_env msg_act hspp_file
else
- hscFileFrontEnd hsc_env msg_act location
+ hscFileFrontEnd hsc_env msg_act hspp_file
; case front_res of
Left flure -> return flure;
maybe_bcos)
}}
-hscCoreFrontEnd hsc_env msg_act location = do {
+hscCoreFrontEnd hsc_env msg_act hspp_file = do {
-------------------
-- PARSE
-------------------
- ; inp <- readFile (expectJust "hscCoreFrontEnd:hspp" (ml_hspp_file location))
+ ; inp <- readFile hspp_file
; case parseCore inp 1 of
FailP s -> putMsg s{-ToDo: wrong-} >> return (Left HscFail)
OkP rdr_module -> do {
}}}
-hscFileFrontEnd hsc_env msg_act location = do {
+hscFileFrontEnd hsc_env msg_act hspp_file = do {
-------------------
-- PARSE
-------------------
- ; maybe_parsed <- myParseModule (hsc_dflags hsc_env)
- (expectJust "hscFrontEnd:hspp" (ml_hspp_file location))
+ ; maybe_parsed <- myParseModule (hsc_dflags hsc_env) hspp_file
; case maybe_parsed of {
Left err -> do { msg_act (unitBag err, emptyBag) ;
; return (Left HscFail) ;
};
- Right rdr_module -> hscFrontEnd hsc_env msg_act rdr_module
- }}
+ Right rdr_module -> do {
+
+ -------------------
+ -- RENAME and TYPECHECK
+ -------------------
+ ; (tc_msgs, maybe_tc_result) <- _scc_ "Typecheck-Rename"
+ tcRnModule hsc_env rdr_module
+ ; msg_act tc_msgs
+ ; case maybe_tc_result of {
+ Nothing -> return (Left HscFail);
+ Just tc_result -> do {
+
+ -------------------
+ -- DESUGAR
+ -------------------
+ ; (warns, maybe_ds_result) <- _scc_ "DeSugar"
+ deSugar hsc_env tc_result
+ ; msg_act (warns, emptyBag)
+ ; case maybe_ds_result of
+ Nothing -> return (Left HscFail);
+ Just ds_result -> return (Right ds_result);
+ }}}}}
+
+
+hscFileCheck hsc_env msg_act hspp_file = do {
+ -------------------
+ -- PARSE
+ -------------------
+ ; maybe_parsed <- myParseModule (hsc_dflags hsc_env) hspp_file
+
+ ; case maybe_parsed of {
+ Left err -> do { msg_act (unitBag err, emptyBag) ;
+ ; return HscFail ;
+ };
+ Right rdr_module -> hscBufferTypecheck hsc_env rdr_module msg_act
+ }}
+
-- Perform static/dynamic checks on the source code in a StringBuffer
-- This is a temporary solution: it'll read in interface files lazily, whereas
-- we probably want to use the compilation manager to load in all the modules
-- in a project.
-hscBufferFrontEnd :: HscEnv -> StringBuffer -> MessageAction -> IO HscResult
-hscBufferFrontEnd hsc_env buffer msg_act = do
+hscBufferCheck :: HscEnv -> StringBuffer -> MessageAction -> IO HscResult
+hscBufferCheck hsc_env buffer msg_act = do
let loc = mkSrcLoc (mkFastString "*edit*") 1 0
showPass (hsc_dflags hsc_env) "Parser"
case unP parseModule (mkPState buffer loc (hsc_dflags hsc_env)) of
msg_act tc_msgs
case maybe_tc_result of
Nothing -> return (HscChecked rdr_module Nothing)
- Just r -> return (HscChecked rdr_module (Just r))
-- space leak on rdr_module!
+ Just r -> return (HscChecked rdr_module (Just r))
-hscFrontEnd hsc_env msg_act rdr_module = do {
- -------------------
- -- RENAME and TYPECHECK
- -------------------
- ; (tc_msgs, maybe_tc_result) <- _scc_ "Typecheck-Rename"
- tcRnModule hsc_env rdr_module
- ; msg_act tc_msgs
- ; case maybe_tc_result of {
- Nothing -> return (Left HscFail);
- Just tc_result -> do {
-
- -------------------
- -- DESUGAR
- -------------------
- ; (warns, maybe_ds_result) <- _scc_ "DeSugar"
- deSugar hsc_env tc_result
- ; msg_act (warns, emptyBag)
- ; case maybe_ds_result of
- Nothing -> return (Left HscFail);
- Just ds_result -> return (Right ds_result);
- }}}
-
hscBackEnd dflags
ModGuts{ -- This is the last use of the ModGuts in a compilation.
-- From now on, we just use the bits we need.