import DriverState ( v_HCHeader )
import DriverPhases ( isExtCore_file )
import ErrUtils ( dumpIfSet_dyn, showPass, printError )
-import Util ( unJust )
import UniqSupply ( mkSplitUniqSupply )
import Bag ( consBag, emptyBag )
import Name ( Name, nameModule, nameOccName, getName )
import NameEnv ( emptyNameEnv, mkNameEnv )
import Module ( Module )
+import FastString
+import Maybes ( expectJust )
+import Util ( seqList )
import IOExts ( newIORef, readIORef, writeIORef,
unsafePerformIO )
Right (this_mod, rdr_module,
dont_discard, new_iface,
pcs_tc, ds_details, foreign_stuff) -> do {
+
+ let {
+ imported_module_names =
+ filter (/= gHC_PRIM_Name) $
+ map ideclName (hsModuleImports rdr_module);
+
+ imported_modules =
+ map (moduleNameToModule hit (pcs_PIT pcs_tc))
+ imported_module_names;
+ }
+
+ -- force this out now, so we don't keep a hold of rdr_module or pcs_tc
+ ; seqList imported_modules (return ())
+
-------------------
-- FLATTENING
-------------------
pcs_rules = rules }
else return pcs_tc
+-- Should we remove bits of flat_details at this point?
+-- ; flat_details <- case flat_details of
+-- ModDetails { md_binds = binds } ->
+-- return ModDetails { md_binds = binds,
+-- md_rules = [],
+-- md_types = emptyTypeEnv,
+-- md_insts = [] }
+
-- alive at this point:
-- pcs_middle
-- foreign_stuff
- -- ds_details
- -- new_iface
+ -- flat_details
+ -- imported_modules (seq'd)
+ -- new_iface
-------------------
-- SIMPLIFY
local_tycons = typeEnvTyCons env_tc
local_classes = typeEnvClasses env_tc
- imported_module_names =
- filter (/= gHC_PRIM_Name) $
- map ideclName (hsModuleImports rdr_module)
- -- eek! doesn't this keep rdr_module live until code generation?
- -- SDM 3/2002
-
- mod_name_to_Module nm
- = do m <- findModule nm ; return (fst (fromJust m))
-
(h_code, c_code, headers, fe_binders) = foreign_stuff
-- turn the list of headers requested in foreign import
--
foreign_headers =
unlines
- . map (\fname -> "#include \"" ++ _UNPK_ fname ++ "\"")
+ . map (\fname -> "#include \"" ++ unpackFS fname ++ "\"")
. reverse
$ headers
; fhdrs <- readIORef v_HCHeader
; writeIORef v_HCHeader (fhdrs ++ foreign_headers)
- ; imported_modules <- mapM mod_name_to_Module imported_module_names
-
; (stub_h_exists, stub_c_exists, maybe_bcos, final_iface )
<- if toInterp
#ifdef GHCI
-------------------
-- PARSE
-------------------
- ; inp <- readFile (unJust "hscCoreFrontEnd:hspp" (ml_hspp_file location))
+ ; inp <- readFile (expectJust "hscCoreFrontEnd:hspp" (ml_hspp_file location))
; case parseCore inp 1 of
FailP s -> hPutStrLn stderr s >> return (Left (HscFail pcs_ch));
OkP rdr_module -> do {
-- PARSE
-------------------
; maybe_parsed <- myParseModule dflags
- (unJust "hscRecomp:hspp" (ml_hspp_file location))
+ (expectJust "hscRecomp:hspp" (ml_hspp_file location))
; case maybe_parsed of {
Nothing -> return (Left (HscFail pcs_ch));
Just rdr_module -> do {
let exts = ExtFlags {glasgowExtsEF = dopt Opt_GlasgowExts dflags,
parrEF = dopt Opt_PArr dflags}
- loc = mkSrcLoc (_PK_ src_filename) 1
+ loc = mkSrcLoc (mkFastString src_filename) 1
case parseModule buf (mkPState loc exts) of {
let exts = ExtFlags {glasgowExtsEF = dopt Opt_GlasgowExts dflags,
parrEF = dopt Opt_PArr dflags}
- loc = mkSrcLoc SLIT("<interactive>") 1
+ loc = mkSrcLoc FSLIT("<interactive>") 1
case parseStmt buf (mkPState loc exts) of {
let exts = ExtFlags {glasgowExtsEF = dopt Opt_GlasgowExts dflags,
parrEF = dopt Opt_PArr dflags}
- loc = mkSrcLoc SLIT("<interactive>") 1
+ loc = mkSrcLoc FSLIT("<interactive>") 1
case parseIdentifier buf (mkPState loc exts) of