- Nothing -> return (HscFail pcs_rn);
- Just tc_result -> do {
-
- let pcs_tc = tc_pcs tc_result
- env_tc = tc_env tc_result
- binds_tc = tc_binds tc_result
- local_insts = tc_insts tc_result
- ;
- -- DESUGAR, SIMPLIFY, TIDY-CORE
- -- We grab the the unfoldings at this point.
- (tidy_binds, orphan_rules, foreign_stuff)
- <- dsThenSimplThenTidy dflags (pcs_rules pcs_tc) this_mod tc_result hst
- ;
- -- CONVERT TO STG
- (stg_binds, oa_tidy_binds, cost_centre_info, top_level_ids)
- <- myCoreToStg dflags this_mod tidy_binds
- ;
- -- cook up a new ModDetails now we (finally) have all the bits
- let new_details = mkModDetails env_tc local_insts tidy_binds
- top_level_ids orphan_rules
- ;
- -- and possibly create a new ModIface
- let maybe_final_iface_and_sdoc
- = completeIface maybe_checked_iface new_iface new_details
- maybe_final_iface
- = case maybe_final_iface_and_sdoc of
- Just (fif, sdoc) -> Just fif; Nothing -> Nothing
- ;
- -- Write the interface file
- writeIface finder maybe_final_iface
- ;
- -- do the rest of code generation/emission
- (maybe_stub_h_filename, maybe_stub_c_filename, maybe_ibinds)
- <- restOfCodeGeneration dflags toInterp summary
- cost_centre_info foreign_stuff env_tc stg_binds oa_tidy_binds
- hit (pcs_PIT pcs_tc)
- ;
- -- and the answer is ...
- return (HscOK new_details maybe_final_iface
- maybe_stub_h_filename maybe_stub_c_filename
- maybe_ibinds pcs_tc)
- }}}}}}}
-
-
-myParseModule dflags summary
+ Nothing -> return (HscFail pcs_cl);
+ Just (pcs_tc, new_details) ->
+
+ return (HscNoRecomp pcs_tc new_details old_iface)
+ }}}
+
+compMsg use_object mod location =
+ mod_str ++ take (max 0 (16 - length mod_str)) (repeat ' ')
+ ++" ( " ++ unJust "hscRecomp" (ml_hs_file location) ++ ", "
+ ++ (if use_object
+ then unJust "hscRecomp" (ml_obj_file location)
+ else "interpreted")
+ ++ " )"
+ where mod_str = moduleUserString mod
+
+
+hscRecomp ghci_mode dflags have_object
+ mod location maybe_checked_iface hst hit pcs_ch
+ = do {
+ -- what target are we shooting for?
+ ; let toInterp = dopt_HscLang dflags == HscInterpreted
+
+ ; when (verbosity dflags >= 1) $
+ hPutStrLn stderr ("Compiling " ++
+ compMsg (not toInterp) mod location);
+
+ -------------------
+ -- PARSE
+ -------------------
+ ; maybe_parsed <- myParseModule dflags
+ (unJust "hscRecomp:hspp" (ml_hspp_file location))
+ ; case maybe_parsed of {
+ Nothing -> return (HscFail pcs_ch);
+ Just rdr_module -> do {
+ ; let this_mod = mkHomeModule (hsModuleName rdr_module)
+
+ -------------------
+ -- RENAME
+ -------------------
+ ; (pcs_rn, print_unqualified, maybe_rn_result)
+ <- _scc_ "Rename"
+ renameModule dflags hit hst pcs_ch this_mod rdr_module
+ ; case maybe_rn_result of {
+ Nothing -> return (HscFail pcs_ch{-was: pcs_rn-});
+ Just (is_exported, new_iface, rn_hs_decls) -> do {
+
+ -- In interactive mode, we don't want to discard any top-level entities at
+ -- all (eg. do not inline them away during simplification), and retain them
+ -- all in the TypeEnv so they are available from the command line.
+ --
+ -- isGlobalName separates the user-defined top-level names from those
+ -- introduced by the type checker.
+ ; let dont_discard | ghci_mode == Interactive = isGlobalName
+ | otherwise = is_exported
+
+ -------------------
+ -- TYPECHECK
+ -------------------
+ ; maybe_tc_result
+ <- _scc_ "TypeCheck" typecheckModule dflags pcs_rn hst new_iface
+ print_unqualified rn_hs_decls
+ ; case maybe_tc_result of {
+ Nothing -> return (HscFail pcs_ch{-was: pcs_rn-});
+ Just (pcs_tc, tc_result) -> do {
+
+ -------------------
+ -- DESUGAR
+ -------------------
+ ; (ds_details, foreign_stuff)
+ <- _scc_ "DeSugar"
+ deSugar dflags pcs_tc hst this_mod print_unqualified tc_result
+
+ ; pcs_middle
+ <- if ghci_mode == OneShot
+ then do init_pcs <- initPersistentCompilerState
+ init_prs <- initPersistentRenamerState
+ let
+ rules = pcs_rules pcs_tc
+ orig_tc = prsOrig (pcs_PRS pcs_tc)
+ new_prs = init_prs{ prsOrig=orig_tc }
+
+ orig_tc `seq` rules `seq` new_prs `seq`
+ return init_pcs{ pcs_PRS = new_prs,
+ pcs_rules = rules }
+ else return pcs_tc
+
+ -------------------
+ -- SIMPLIFY
+ -------------------
+ ; simpl_details
+ <- _scc_ "Core2Core"
+ core2core dflags pcs_middle hst dont_discard ds_details
+
+ -------------------
+ -- TIDY
+ -------------------
+ ; cg_info_ref <- newIORef Nothing ;
+ ; let cg_info :: CgInfoEnv
+ cg_info = unsafePerformIO $ do {
+ maybe_cg_env <- readIORef cg_info_ref ;
+ case maybe_cg_env of
+ Just env -> return env
+ Nothing -> do { printError "Urk! Looked at CgInfo too early!";
+ return emptyNameEnv } }
+ -- cg_info_ref will be filled in just after restOfCodeGeneration
+ -- Meanwhile, tidyCorePgm is careful not to look at cg_info!
+
+ ; (pcs_simpl, tidy_details)
+ <- _scc_ "CoreTidy"
+ tidyCorePgm dflags this_mod pcs_middle cg_info simpl_details
+
+ ; pcs_final <- if ghci_mode == OneShot then initPersistentCompilerState
+ else return pcs_simpl
+
+ -- alive at this point:
+ -- tidy_details
+ -- new_iface
+
+ -------------------
+ -- PREPARE FOR CODE GENERATION
+ -------------------
+ -- Do saturation and convert to A-normal form
+ ; prepd_details <- _scc_ "CorePrep" corePrepPgm dflags tidy_details
+
+ -------------------
+ -- CONVERT TO STG and COMPLETE CODE GENERATION
+ -------------------
+ ; let
+ ModDetails{md_binds=binds, md_types=env_tc} = prepd_details
+
+ local_tycons = typeEnvTyCons env_tc
+ local_classes = typeEnvClasses env_tc
+
+ imported_module_names = map ideclName (hsModuleImports rdr_module)
+
+ mod_name_to_Module nm
+ = do m <- findModule nm ; return (fst (fromJust m))
+
+ (h_code,c_code,fe_binders) = foreign_stuff
+
+ ; imported_modules <- mapM mod_name_to_Module imported_module_names
+
+ ; (stub_h_exists, stub_c_exists, maybe_bcos, final_iface )
+ <- if toInterp
+ then do
+ ----------------- Generate byte code ------------------
+ (bcos,itbl_env) <- byteCodeGen dflags binds
+ local_tycons local_classes
+
+ -- Fill in the code-gen info
+ writeIORef cg_info_ref (Just emptyNameEnv)
+
+ ------------------ BUILD THE NEW ModIface ------------
+ final_iface <- _scc_ "MkFinalIface"
+ mkFinalIface ghci_mode dflags location
+ maybe_checked_iface new_iface tidy_details
+
+ return ( False, False, Just (bcos,itbl_env), final_iface )
+
+ else do
+ ----------------- Convert to STG ------------------
+ (stg_binds, cost_centre_info, stg_back_end_info)
+ <- _scc_ "CoreToStg"
+ myCoreToStg dflags this_mod binds
+
+ -- Fill in the code-gen info for the earlier tidyCorePgm
+ writeIORef cg_info_ref (Just stg_back_end_info)
+
+ ------------------ BUILD THE NEW ModIface ------------
+ final_iface <- _scc_ "MkFinalIface"
+ mkFinalIface ghci_mode dflags location
+ maybe_checked_iface new_iface tidy_details
+
+ ------------------ Code generation ------------------
+ abstractC <- _scc_ "CodeGen"
+ codeGen dflags this_mod imported_modules
+ cost_centre_info fe_binders
+ local_tycons stg_binds
+
+ ------------------ Code output -----------------------
+ (stub_h_exists, stub_c_exists)
+ <- codeOutput dflags this_mod local_tycons
+ binds stg_binds
+ c_code h_code abstractC
+
+ return (stub_h_exists, stub_c_exists, Nothing, final_iface)
+
+ ; let final_details = tidy_details {md_binds = []}
+
+
+ -- and the answer is ...
+ ; return (HscRecomp pcs_final
+ final_details
+ final_iface
+ stub_h_exists stub_c_exists
+ maybe_bcos)
+ }}}}}}}
+
+myParseModule dflags src_filename