X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FDriverPipeline.hs;h=c4c49bedd68e40a558f4e0963eecea21f7ebb2f9;hb=8d48737f404f079a3deec1c00c86aa028a124efb;hp=5355d8f36c6ce27f65716a285a8d6e421ce1d9b1;hpb=3a61d75c70f61a2b919e94e85ffe1166e7151b5b;p=ghc-hetmet.git diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index 5355d8f..c4c49be 100644 --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -19,7 +19,7 @@ module DriverPipeline ( -- Interfaces for the compilation manager (interpreted/batch-mode) preprocess, - compile, + compile, compile', link, ) where @@ -153,7 +153,7 @@ compile hsc_env0 summary mod_index nmods mb_old_iface maybe_old_linkable = ASSERT (isJust maybe_old_linkable) return maybe_old_linkable - handleBatch (HscRecomp hasStub) + handleBatch (HscRecomp hasStub _) | isHsBoot src_flavour = do when (isObjectTarget hsc_lang) $ -- interpreted reaches here too liftIO $ SysTools.touch dflags' "Touching object file" @@ -179,10 +179,13 @@ compile hsc_env0 summary mod_index nmods mb_old_iface maybe_old_linkable (hs_unlinked ++ stub_unlinked) return (Just linkable) - handleInterpreted InteractiveNoRecomp + handleInterpreted HscNoRecomp = ASSERT (isJust maybe_old_linkable) return maybe_old_linkable - handleInterpreted (InteractiveRecomp hasStub comp_bc modBreaks) + handleInterpreted (HscRecomp _hasStub Nothing) + = ASSERT (isHsBoot src_flavour) + return maybe_old_linkable + handleInterpreted (HscRecomp hasStub (Just (comp_bc, modBreaks))) = do stub_unlinked <- getStubLinkable hasStub let hs_unlinked = [BCOs comp_bc modBreaks] unlinked_time = ms_hs_date summary @@ -665,9 +668,9 @@ runPhase (Cpp sf) _stop hsc_env _basename _suff input_fn get_output_fn maybe_loc = do let dflags0 = hsc_dflags hsc_env src_opts <- liftIO $ getOptionsFromFile dflags0 input_fn (dflags, unhandled_flags, warns) - <- liftIO $ parseDynamicFlags dflags0 src_opts - liftIO $ handleFlagWarnings dflags warns -- XXX: may exit the program - liftIO $ checkProcessArgsResult unhandled_flags -- XXX: may throw program error + <- liftIO $ parseDynamicNoPackageFlags dflags0 src_opts + handleFlagWarnings dflags warns + checkProcessArgsResult unhandled_flags if not (dopt Opt_Cpp dflags) then -- no need to preprocess CPP, just pass input file along @@ -726,8 +729,8 @@ runPhase (Hsc src_flavour) stop hsc_env basename suff input_fn get_output_fn _ma m <- liftIO $ getCoreModuleName input_fn return (Nothing, mkModuleName m, [], []) - _ -> liftIO $ do - buf <- hGetStringBuffer input_fn + _ -> do + buf <- liftIO $ hGetStringBuffer input_fn (src_imps,imps,L _ mod_name) <- getImports dflags buf input_fn (basename <.> suff) return (Just buf, mod_name, imps, src_imps) @@ -830,7 +833,7 @@ runPhase (Hsc src_flavour) stop hsc_env basename suff input_fn get_output_fn _ma -- than the source file (else we wouldn't be in HscNoRecomp) -- but we touch it anyway, to keep 'make' happy (we think). return (StopLn, dflags', Just location4, o_file) - (HscRecomp hasStub) + (HscRecomp hasStub _) -> do when hasStub $ do stub_o <- compileStub hsc_env' mod location4 liftIO $ consIORef v_Ld_inputs stub_o @@ -1188,8 +1191,8 @@ runPhase_MoveBinary dflags input_fn dep_packages Wrapped wrapmode -> do let (o_base, o_ext) = splitExtension input_fn - let wrapped_executable | o_ext == "exe" = (o_base ++ "_real") <.> o_ext - | otherwise = input_fn ++ "_real" + let wrapped_executable | o_ext == "exe" = (o_base ++ ".dyn") <.> o_ext + | otherwise = input_fn ++ ".dyn" behaviour <- wrapper_behaviour dflags wrapmode dep_packages -- THINKME isn't this possible to do a bit nicer? @@ -1494,8 +1497,14 @@ linkDynLib dflags o_files dep_packages = do -- because the RTS lib comes in several flavours and we want to be -- able to pick the flavour when a binary is linked. pkgs <- getPreloadPackagesAnd dflags dep_packages - let pkgs_no_rts = filter ((/= rtsPackageId) . packageConfigId) pkgs + -- On Windows we need to link the RTS import lib as Windows does + -- not allow undefined symbols. +#if !defined(mingw32_HOST_OS) + let pkgs_no_rts = filter ((/= rtsPackageId) . packageConfigId) pkgs +#else + let pkgs_no_rts = pkgs +#endif let pkg_lib_paths = collectLibraryPaths pkgs_no_rts let pkg_lib_path_opts = map ("-L"++) pkg_lib_paths