2 % (c) The GRASP/AQUA Project, Glasgow University, 1993-2000
5 \section[GHC_Main]{Main driver for Glasgow Haskell compiler}
9 ( newHscEnv, hscCmmFile
13 , hscStmt, hscTcExpr, hscKcType
16 , hscCompileOneShot -- :: Compiler HscStatus
17 , hscCompileMake -- :: Compiler (HscStatus, ModIface, ModDetails)
18 , hscCompileInteractive -- :: Compiler (InteractiveStatus, ModIface, ModDetails)
20 , InteractiveStatus (..)
24 #include "HsVersions.h"
27 import HsSyn ( Stmt(..), LHsExpr, LStmt, LHsType )
28 import Module ( Module )
29 import CodeOutput ( outputForeignStubs )
30 import ByteCodeGen ( byteCodeGen, coreExprToBCOs )
31 import Linker ( HValue, linkExpr )
32 import CoreTidy ( tidyExpr )
33 import CorePrep ( corePrepExpr )
34 import Flattening ( flattenExpr )
35 import TcRnDriver ( tcRnStmt, tcRnExpr, tcRnType )
37 import PrelNames ( iNTERACTIVE )
39 import CoreLint ( lintUnfolding )
40 import DsMeta ( templateHaskellNames )
41 import SrcLoc ( noSrcLoc )
42 import VarEnv ( emptyTidyEnv )
46 import Module ( emptyModuleEnv, ModLocation(..) )
47 import RdrName ( GlobalRdrEnv, RdrName )
48 import HsSyn ( HsModule, LHsBinds, HsGroup, LIE, LImportDecl )
49 import SrcLoc ( Located(..) )
50 import StringBuffer ( hGetStringBuffer, stringToStringBuffer )
52 import Lexer ( P(..), ParseResult(..), mkPState )
53 import SrcLoc ( mkSrcLoc )
54 import TcRnDriver ( tcRnModule, tcRnExtCore )
55 import TcIface ( typecheckIface )
56 import TcRnMonad ( initIfaceCheck, TcGblEnv(..) )
57 import IfaceEnv ( initNameCache )
58 import LoadIface ( ifaceStats, initExternalPackageState )
59 import PrelInfo ( wiredInThings, basicKnownKeyNames )
60 import MkIface ( checkOldIface, mkIface, writeIfaceFile )
62 import Flattening ( flatten )
64 import TidyPgm ( tidyProgram, mkBootModDetails )
65 import CorePrep ( corePrepPgm )
66 import CoreToStg ( coreToStg )
67 import TyCon ( isDataTyCon )
68 import Packages ( mkHomeModules )
69 import Name ( Name, NamedThing(..) )
70 import SimplStg ( stg2stg )
71 import CodeGen ( codeGen )
72 import CmmParse ( parseCmmFile )
73 import CodeOutput ( codeOutput )
78 import UniqSupply ( mkSplitUniqSupply )
81 import HscStats ( ppSourceStats )
83 import MkExternalCore ( emitExternalCore )
85 import ParserCoreUtils
87 import Maybes ( expectJust )
88 import Bag ( unitBag )
90 import Maybe ( isJust )
92 import DATA_IOREF ( newIORef, readIORef )
96 %************************************************************************
100 %************************************************************************
103 newHscEnv :: DynFlags -> IO HscEnv
105 = do { eps_var <- newIORef initExternalPackageState
106 ; us <- mkSplitUniqSupply 'r'
107 ; nc_var <- newIORef (initNameCache us knownKeyNames)
108 ; fc_var <- newIORef emptyModuleEnv
109 ; return (HscEnv { hsc_dflags = dflags,
112 hsc_IC = emptyInteractiveContext,
113 hsc_HPT = emptyHomePackageTable,
116 hsc_FC = fc_var } ) }
119 knownKeyNames :: [Name] -- Put here to avoid loops involving DsMeta,
120 -- where templateHaskellNames are defined
121 knownKeyNames = map getName wiredInThings
122 ++ basicKnownKeyNames
124 ++ templateHaskellNames
129 %************************************************************************
131 The main compiler pipeline
133 %************************************************************************
135 --------------------------------
136 The compilation proper
137 --------------------------------
140 It's the task of the compilation proper to compile Haskell, hs-boot and
141 core files to either byte-code, hard-code (C, asm, Java, ect) or to
142 nothing at all (the module is still parsed and type-checked. This
143 feature is mostly used by IDE's and the likes).
144 Compilation can happen in either 'one-shot', 'make', or 'interactive'
145 mode. 'One-shot' mode targets hard-code, 'make' mode targets hard-code
146 and nothing, and 'interactive' mode targets byte-code. The modes are
147 kept separate because of their different types.
148 In 'one-shot' mode, we're only compiling a single file and can therefore
149 discard the new ModIface and ModDetails. This is also the reason it only
150 targets hard-code; compiling to byte-code or nothing doesn't make sense
151 when we discard the result. 'Make' mode is like 'one-shot' except that we
152 keep the resulting ModIface and ModDetails. 'Make' mode doesn't target
153 byte-code since that require us to return the newly compiled byte-code.
154 'Interactive' mode is similar to 'make' mode except that we return
155 the compiled byte-code together with the ModIface and ModDetails.
156 Trying to compile a hs-boot file to byte-code will result in a run-time
157 error. This is the only thing that isn't caught by the type-system.
164 (Located (HsModule RdrName))
166 (Maybe (HsGroup Name,[LImportDecl Name],Maybe [LIE Name]))
168 (Maybe (LHsBinds Id, GlobalRdrEnv, ModDetails))
171 -- Status of a compilation to hard-code or nothing.
174 | HscRecomp Bool -- Has stub files.
175 -- This is a hack. We can't compile C files here
176 -- since it's done in DriverPipeline. For now we
177 -- just return True if we want the caller to compile
180 -- Status of a compilation to byte-code.
181 data InteractiveStatus
182 = InteractiveNoRecomp
183 | InteractiveRecomp Bool -- Same as HscStatus
186 type NoRecomp result = HscEnv -> ModSummary -> Bool -> ModIface -> Maybe (Int,Int) -> IO result
187 type FrontEnd core = HscEnv -> ModSummary -> Maybe (Int,Int) -> IO (Maybe core)
188 type BackEnd core prepCore = HscEnv -> ModSummary -> Maybe ModIface -> core -> IO prepCore
189 type CodeGen prepCore result = HscEnv -> ModSummary -> prepCore -> IO result
191 type Compiler result = HscEnv
193 -> Bool -- True <=> source unchanged
194 -> Bool -- True <=> have an object file (for msgs only)
195 -> Maybe ModIface -- Old interface, if available
196 -> Maybe (Int,Int) -- Just (i,n) <=> module i of n (for msgs)
200 -- This functions checks if recompilation is necessary and
201 -- then combines the FrontEnd, BackEnd and CodeGen to a
203 hscMkCompiler :: NoRecomp result -- What to do when recompilation isn't required.
205 -> BackEnd core prepCore
206 -> CodeGen prepCore result
208 hscMkCompiler norecomp frontend backend codegen
209 hsc_env mod_summary source_unchanged
210 have_object mbOldIface mbModIndex
211 = do (recomp_reqd, mbCheckedIface)
212 <- {-# SCC "checkOldIface" #-}
213 checkOldIface hsc_env mod_summary
214 source_unchanged mbOldIface
215 case mbCheckedIface of
216 Just iface | not recomp_reqd
217 -> do result <- norecomp hsc_env mod_summary have_object iface mbModIndex
220 -> do mbCore <- frontend hsc_env mod_summary mbModIndex
225 -> do prepCore <- backend hsc_env mod_summary
227 result <- codegen hsc_env mod_summary prepCore
230 --------------------------------------------------------------
232 --------------------------------------------------------------
234 -- Compile Haskell, boot and extCore in OneShot mode.
235 hscCompileOneShot :: Compiler HscStatus
236 hscCompileOneShot hsc_env mod_summary =
237 compiler hsc_env mod_summary
238 where mkComp = hscMkCompiler (norecompOneShot HscNoRecomp)
240 = case ms_hsc_src mod_summary of
242 -> mkComp hscCoreFrontEnd hscNewBackEnd hscCodeGenOneShot
245 -> mkComp hscFileFrontEnd hscNewBackEnd hscCodeGenOneShot
247 -> mkComp hscFileFrontEnd hscNewBootBackEnd
248 (hscCodeGenConst (HscRecomp False))
250 -- Compile Haskell, boot and extCore in --make mode.
251 hscCompileMake :: Compiler (HscStatus, ModIface, ModDetails)
252 hscCompileMake hsc_env mod_summary
253 = compiler hsc_env mod_summary
254 where mkComp = hscMkCompiler norecompMake
255 backend = case hscTarget (hsc_dflags hsc_env) of
256 HscNothing -> hscCodeGenSimple (\(i, d, g) -> (HscRecomp False, i, d))
257 _other -> hscCodeGenMake
259 = case ms_hsc_src mod_summary of
261 -> mkComp hscCoreFrontEnd hscNewBackEnd backend
263 -> mkComp hscFileFrontEnd hscNewBackEnd backend
265 -> mkComp hscFileFrontEnd hscNewBootBackEnd hscCodeGenIdentity
268 -- Compile Haskell, extCore to bytecode.
269 hscCompileInteractive :: Compiler (InteractiveStatus, ModIface, ModDetails)
270 hscCompileInteractive hsc_env mod_summary =
271 hscMkCompiler norecompInteractive frontend hscNewBackEnd hscCodeGenInteractive
273 where frontend = case ms_hsc_src mod_summary of
274 ExtCoreFile -> hscCoreFrontEnd
275 HsSrcFile -> hscFileFrontEnd
276 HsBootFile -> panic bootErrorMsg
277 bootErrorMsg = "Compiling a HsBootFile to bytecode doesn't make sense. " ++
278 "Use 'hscCompileMake' instead."
280 --------------------------------------------------------------
282 --------------------------------------------------------------
284 norecompOneShot :: a -> NoRecomp a
285 norecompOneShot a hsc_env mod_summary
286 have_object old_iface
288 = do compilationProgressMsg (hsc_dflags hsc_env) $
289 "compilation IS NOT required"
290 dumpIfaceStats hsc_env
293 norecompMake :: NoRecomp (HscStatus, ModIface, ModDetails)
294 norecompMake = norecompWorker HscNoRecomp
296 norecompInteractive :: NoRecomp (InteractiveStatus, ModIface, ModDetails)
297 norecompInteractive = norecompWorker InteractiveNoRecomp
299 norecompWorker :: a -> NoRecomp (a, ModIface, ModDetails)
300 norecompWorker a hsc_env mod_summary have_object
301 old_iface mb_mod_index
302 = do compilationProgressMsg (hsc_dflags hsc_env) $
303 (showModuleIndex mb_mod_index ++
304 "Skipping " ++ showModMsg have_object mod_summary)
305 new_details <- {-# SCC "tcRnIface" #-}
306 initIfaceCheck hsc_env $
307 typecheckIface old_iface
308 dumpIfaceStats hsc_env
309 return (a, old_iface, new_details)
311 --------------------------------------------------------------
313 --------------------------------------------------------------
315 hscCoreFrontEnd :: FrontEnd ModGuts
316 hscCoreFrontEnd hsc_env mod_summary mb_mod_index = do {
320 ; inp <- readFile (expectJust "hscCoreFrontEnd" (ms_hspp_file mod_summary))
321 ; case parseCore inp 1 of
322 FailP s -> do errorMsg (hsc_dflags hsc_env) (text s{-ToDo: wrong-})
324 OkP rdr_module -> do {
327 -- RENAME and TYPECHECK
329 ; (tc_msgs, maybe_tc_result) <- {-# SCC "TypeCheck" #-}
330 tcRnExtCore hsc_env rdr_module
331 ; printErrorsAndWarnings (hsc_dflags hsc_env) tc_msgs
332 ; case maybe_tc_result of
333 Nothing -> return Nothing
334 Just mod_guts -> return (Just mod_guts) -- No desugaring to do!
337 hscFileFrontEnd :: FrontEnd ModGuts
338 hscFileFrontEnd hsc_env mod_summary mb_mod_index = do {
340 -- DISPLAY PROGRESS MESSAGE
342 ; let dflags = hsc_dflags hsc_env
343 one_shot = isOneShot (ghcMode dflags)
344 toInterp = hscTarget dflags == HscInterpreted
345 ; when (not one_shot) $
346 compilationProgressMsg dflags $
347 (showModuleIndex mb_mod_index ++
348 "Compiling " ++ showModMsg (not toInterp) mod_summary)
353 ; let hspp_file = expectJust "hscFileFrontEnd" (ms_hspp_file mod_summary)
354 hspp_buf = ms_hspp_buf mod_summary
356 ; maybe_parsed <- myParseModule dflags hspp_file hspp_buf
358 ; case maybe_parsed of {
359 Left err -> do { printBagOfErrors dflags (unitBag err)
361 Right rdr_module -> do {
364 -- RENAME and TYPECHECK
366 (tc_msgs, maybe_tc_result)
367 <- {-# SCC "Typecheck-Rename" #-}
368 tcRnModule hsc_env (ms_hsc_src mod_summary) False rdr_module
370 ; printErrorsAndWarnings dflags tc_msgs
371 ; case maybe_tc_result of {
372 Nothing -> return Nothing ;
373 Just tc_result -> do {
378 ; (warns, maybe_ds_result) <- {-# SCC "DeSugar" #-}
379 deSugar hsc_env tc_result
380 ; printBagOfWarnings dflags warns
381 ; return maybe_ds_result
384 --------------------------------------------------------------
386 --------------------------------------------------------------
388 hscNewBootBackEnd :: BackEnd ModGuts (HscStatus, ModIface, ModDetails)
389 hscNewBootBackEnd hsc_env mod_summary maybe_old_iface ds_result
390 = do details <- mkBootModDetails hsc_env ds_result
391 (new_iface, no_change)
392 <- {-# SCC "MkFinalIface" #-}
393 mkIface hsc_env maybe_old_iface ds_result details
394 writeIfaceFile hsc_env (ms_location mod_summary) new_iface no_change
395 -- And the answer is ...
396 dumpIfaceStats hsc_env
397 return (HscRecomp False, new_iface, details)
399 hscNewBackEnd :: BackEnd ModGuts (ModIface, ModDetails, CgGuts)
400 hscNewBackEnd hsc_env mod_summary maybe_old_iface ds_result
402 -- ; seqList imported_modules (return ())
404 let dflags = hsc_dflags hsc_env
409 ; flat_result <- {-# SCC "Flattening" #-}
410 flatten hsc_env ds_result
413 {- TEMP: need to review space-leak fixing here
414 NB: even the code generator can force one of the
415 thunks for constructor arguments, for newtypes in particular
417 ; let -- Rule-base accumulated from imported packages
418 pkg_rule_base = eps_rule_base (hsc_EPS hsc_env)
420 -- In one-shot mode, ZAP the external package state at
421 -- this point, because we aren't going to need it from
422 -- now on. We keep the name cache, however, because
423 -- tidyCore needs it.
425 | one_shot = pcs_tc{ pcs_EPS = error "pcs_EPS missing" }
428 ; pkg_rule_base `seq` pcs_middle `seq` return ()
431 -- alive at this point:
439 ; simpl_result <- {-# SCC "Core2Core" #-}
440 core2core hsc_env flat_result
445 ; (cg_guts, details) <- {-# SCC "CoreTidy" #-}
446 tidyProgram hsc_env simpl_result
448 -- Alive at this point:
449 -- tidy_result, pcs_final
453 -- BUILD THE NEW ModIface and ModDetails
454 -- and emit external core if necessary
455 -- This has to happen *after* code gen so that the back-end
456 -- info has been set. Not yet clear if it matters waiting
457 -- until after code output
458 ; (new_iface, no_change)
459 <- {-# SCC "MkFinalIface" #-}
460 mkIface hsc_env maybe_old_iface simpl_result details
462 ; writeIfaceFile hsc_env (ms_location mod_summary) new_iface no_change
464 -- Emit external core
465 ; emitExternalCore dflags cg_guts
468 -- Return the prepared code.
469 ; return (new_iface, details, cg_guts)
472 --------------------------------------------------------------
474 --------------------------------------------------------------
476 -- Don't output any code.
477 hscCodeGenNothing :: CodeGen (ModIface, ModDetails, CgGuts) (HscStatus, ModIface, ModDetails)
478 hscCodeGenNothing hsc_env mod_summary (iface, details, cgguts)
479 = return (HscRecomp False, iface, details)
481 -- Generate code and return both the new ModIface and the ModDetails.
482 hscCodeGenMake :: CodeGen (ModIface, ModDetails, CgGuts) (HscStatus, ModIface, ModDetails)
483 hscCodeGenMake hsc_env mod_summary (iface, details, cgguts)
484 = do hasStub <- hscCodeGenCompile hsc_env mod_summary cgguts
485 return (HscRecomp hasStub, iface, details)
487 -- Here we don't need the ModIface and ModDetails anymore.
488 hscCodeGenOneShot :: CodeGen (ModIface, ModDetails, CgGuts) HscStatus
489 hscCodeGenOneShot hsc_env mod_summary (_, _, cgguts)
490 = do hasStub <- hscCodeGenCompile hsc_env mod_summary cgguts
491 return (HscRecomp hasStub)
493 hscCodeGenCompile :: CodeGen CgGuts Bool
494 hscCodeGenCompile hsc_env mod_summary cgguts
495 = do let CgGuts{ -- This is the last use of the ModGuts in a compilation.
496 -- From now on, we just use the bits we need.
497 cg_module = this_mod,
498 cg_binds = core_binds,
500 cg_dir_imps = dir_imps,
501 cg_foreign = foreign_stubs,
502 cg_home_mods = home_mods,
503 cg_dep_pkgs = dependencies } = cgguts
504 dflags = hsc_dflags hsc_env
505 location = ms_location mod_summary
506 modName = ms_mod mod_summary
507 data_tycons = filter isDataTyCon tycons
508 -- cg_tycons includes newtypes, for the benefit of External Core,
509 -- but we don't generate any code for newtypes
512 -- PREPARE FOR CODE GENERATION
513 -- Do saturation and convert to A-normal form
514 prepd_binds <- {-# SCC "CorePrep" #-}
515 corePrepPgm dflags core_binds data_tycons ;
516 ----------------- Convert to STG ------------------
517 (stg_binds, cost_centre_info)
518 <- {-# SCC "CoreToStg" #-}
519 myCoreToStg dflags home_mods this_mod prepd_binds
520 ------------------ Code generation ------------------
521 abstractC <- {-# SCC "CodeGen" #-}
522 codeGen dflags home_mods this_mod data_tycons
523 foreign_stubs dir_imps cost_centre_info
525 ------------------ Code output -----------------------
526 (stub_h_exists,stub_c_exists)
527 <- codeOutput dflags this_mod location foreign_stubs
528 dependencies abstractC
531 hscCodeGenIdentity :: CodeGen a a
532 hscCodeGenIdentity hsc_env mod_summary a = return a
534 hscCodeGenSimple :: (a -> b) -> CodeGen a b
535 hscCodeGenSimple fn hsc_env mod_summary a = return (fn a)
537 hscCodeGenConst :: b -> CodeGen a b
538 hscCodeGenConst b hsc_env mod_summary a = return b
540 hscCodeGenInteractive :: CodeGen (ModIface, ModDetails, CgGuts)
541 (InteractiveStatus, ModIface, ModDetails)
542 hscCodeGenInteractive hsc_env mod_summary (iface, details, cgguts)
544 = do let CgGuts{ -- This is the last use of the ModGuts in a compilation.
545 -- From now on, we just use the bits we need.
546 cg_module = this_mod,
547 cg_binds = core_binds,
549 cg_foreign = foreign_stubs,
550 cg_home_mods = home_mods,
551 cg_dep_pkgs = dependencies } = cgguts
552 dflags = hsc_dflags hsc_env
553 location = ms_location mod_summary
554 modName = ms_mod mod_summary
555 data_tycons = filter isDataTyCon tycons
556 -- cg_tycons includes newtypes, for the benefit of External Core,
557 -- but we don't generate any code for newtypes
560 -- PREPARE FOR CODE GENERATION
561 -- Do saturation and convert to A-normal form
562 prepd_binds <- {-# SCC "CorePrep" #-}
563 corePrepPgm dflags core_binds data_tycons ;
564 ----------------- Generate byte code ------------------
565 comp_bc <- byteCodeGen dflags prepd_binds data_tycons
566 ------------------ Create f-x-dynamic C-side stuff ---
567 (istub_h_exists, istub_c_exists)
568 <- outputForeignStubs dflags this_mod location foreign_stubs
569 return (InteractiveRecomp istub_c_exists comp_bc, iface, details)
571 = panic "GHC not compiled with interpreter"
575 ------------------------------
577 hscFileCheck :: HscEnv -> ModSummary -> IO (Maybe HscChecked)
578 hscFileCheck hsc_env mod_summary = do {
582 ; let dflags = hsc_dflags hsc_env
583 hspp_file = expectJust "hscFileFrontEnd" (ms_hspp_file mod_summary)
584 hspp_buf = ms_hspp_buf mod_summary
586 ; maybe_parsed <- myParseModule dflags hspp_file hspp_buf
588 ; case maybe_parsed of {
589 Left err -> do { printBagOfErrors dflags (unitBag err)
591 Right rdr_module -> do {
594 -- RENAME and TYPECHECK
596 (tc_msgs, maybe_tc_result)
597 <- _scc_ "Typecheck-Rename"
598 tcRnModule hsc_env (ms_hsc_src mod_summary)
599 True{-save renamed syntax-}
602 ; printErrorsAndWarnings dflags tc_msgs
603 ; case maybe_tc_result of {
604 Nothing -> return (Just (HscChecked rdr_module Nothing Nothing));
606 let md = ModDetails {
607 md_types = tcg_type_env tc_result,
608 md_exports = tcg_exports tc_result,
609 md_insts = tcg_insts tc_result,
610 md_rules = [panic "no rules"] }
611 -- Rules are CoreRules, not the
612 -- RuleDecls we get out of the typechecker
613 rnInfo = do decl <- tcg_rn_decls tc_result
614 imports <- tcg_rn_imports tc_result
615 let exports = tcg_rn_exports tc_result
616 return (decl,imports,exports)
617 return (Just (HscChecked rdr_module
619 (Just (tcg_binds tc_result,
620 tcg_rdr_env tc_result,
625 hscCmmFile :: DynFlags -> FilePath -> IO Bool
626 hscCmmFile dflags filename = do
627 maybe_cmm <- parseCmmFile dflags (mkHomeModules []) filename
629 Nothing -> return False
631 codeOutput dflags no_mod no_loc NoStubs [] [cmm]
634 no_mod = panic "hscCmmFile: no_mod"
635 no_loc = ModLocation{ ml_hs_file = Just filename,
636 ml_hi_file = panic "hscCmmFile: no hi file",
637 ml_obj_file = panic "hscCmmFile: no obj file" }
640 myParseModule dflags src_filename maybe_src_buf
641 = -------------------------- Parser ----------------
642 showPass dflags "Parser" >>
643 {-# SCC "Parser" #-} do
645 -- sometimes we already have the buffer in memory, perhaps
646 -- because we needed to parse the imports out of it, or get the
648 buf <- case maybe_src_buf of
650 Nothing -> hGetStringBuffer src_filename
652 let loc = mkSrcLoc (mkFastString src_filename) 1 0
654 case unP parseModule (mkPState buf loc dflags) of {
656 PFailed span err -> return (Left (mkPlainErrMsg span err));
658 POk _ rdr_module -> do {
660 dumpIfSet_dyn dflags Opt_D_dump_parsed "Parser" (ppr rdr_module) ;
662 dumpIfSet_dyn dflags Opt_D_source_stats "Source Statistics"
663 (ppSourceStats False rdr_module) ;
665 return (Right rdr_module)
666 -- ToDo: free the string buffer later.
670 myCoreToStg dflags home_mods this_mod prepd_binds
672 stg_binds <- {-# SCC "Core2Stg" #-}
673 coreToStg home_mods prepd_binds
675 (stg_binds2, cost_centre_info) <- {-# SCC "Stg2Stg" #-}
676 stg2stg dflags home_mods this_mod stg_binds
678 return (stg_binds2, cost_centre_info)
682 %************************************************************************
684 \subsection{Compiling a do-statement}
686 %************************************************************************
688 When the UnlinkedBCOExpr is linked you get an HValue of type
690 When you run it you get a list of HValues that should be
691 the same length as the list of names; add them to the ClosureEnv.
693 A naked expression returns a singleton Name [it].
695 What you type The IO [HValue] that hscStmt returns
696 ------------- ------------------------------------
697 let pat = expr ==> let pat = expr in return [coerce HVal x, coerce HVal y, ...]
700 pat <- expr ==> expr >>= \ pat -> return [coerce HVal x, coerce HVal y, ...]
703 expr (of IO type) ==> expr >>= \ v -> return [v]
704 [NB: result not printed] bindings: [it]
707 expr (of non-IO type,
708 result showable) ==> let v = expr in print v >> return [v]
711 expr (of non-IO type,
712 result not showable) ==> error
716 hscStmt -- Compile a stmt all the way to an HValue, but don't run it
718 -> String -- The statement
719 -> IO (Maybe (HscEnv, [Name], HValue))
722 = do { maybe_stmt <- hscParseStmt (hsc_dflags hsc_env) stmt
723 ; case maybe_stmt of {
724 Nothing -> return Nothing ; -- Parse error
725 Just Nothing -> return Nothing ; -- Empty line
726 Just (Just parsed_stmt) -> do { -- The real stuff
728 -- Rename and typecheck it
729 let icontext = hsc_IC hsc_env
730 ; maybe_tc_result <- tcRnStmt hsc_env icontext parsed_stmt
732 ; case maybe_tc_result of {
733 Nothing -> return Nothing ;
734 Just (new_ic, bound_names, tc_expr) -> do {
736 -- Then desugar, code gen, and link it
737 ; hval <- compileExpr hsc_env iNTERACTIVE
738 (ic_rn_gbl_env new_ic)
742 ; return (Just (hsc_env{ hsc_IC=new_ic }, bound_names, hval))
745 hscTcExpr -- Typecheck an expression (but don't run it)
747 -> String -- The expression
750 hscTcExpr hsc_env expr
751 = do { maybe_stmt <- hscParseStmt (hsc_dflags hsc_env) expr
752 ; let icontext = hsc_IC hsc_env
753 ; case maybe_stmt of {
754 Nothing -> return Nothing ; -- Parse error
755 Just (Just (L _ (ExprStmt expr _ _)))
756 -> tcRnExpr hsc_env icontext expr ;
757 Just other -> do { errorMsg (hsc_dflags hsc_env) (text "not an expression:" <+> quotes (text expr)) ;
761 hscKcType -- Find the kind of a type
763 -> String -- The type
766 hscKcType hsc_env str
767 = do { maybe_type <- hscParseType (hsc_dflags hsc_env) str
768 ; let icontext = hsc_IC hsc_env
769 ; case maybe_type of {
770 Just ty -> tcRnType hsc_env icontext ty ;
771 Just other -> do { errorMsg (hsc_dflags hsc_env) (text "not an type:" <+> quotes (text str)) ;
773 Nothing -> return Nothing } }
779 hscParseStmt :: DynFlags -> String -> IO (Maybe (Maybe (LStmt RdrName)))
780 hscParseStmt = hscParseThing parseStmt
782 hscParseType :: DynFlags -> String -> IO (Maybe (LHsType RdrName))
783 hscParseType = hscParseThing parseType
786 hscParseIdentifier :: DynFlags -> String -> IO (Maybe (Located RdrName))
787 hscParseIdentifier = hscParseThing parseIdentifier
789 hscParseThing :: Outputable thing
791 -> DynFlags -> String
793 -- Nothing => Parse error (message already printed)
795 hscParseThing parser dflags str
796 = showPass dflags "Parser" >>
797 {-# SCC "Parser" #-} do
799 buf <- stringToStringBuffer str
801 let loc = mkSrcLoc FSLIT("<interactive>") 1 0
803 case unP parser (mkPState buf loc dflags) of {
805 PFailed span err -> do { printError span err;
810 --ToDo: can't free the string buffer until we've finished this
811 -- compilation sweep and all the identifiers have gone away.
812 dumpIfSet_dyn dflags Opt_D_dump_parsed "Parser" (ppr thing);
817 %************************************************************************
819 Desugar, simplify, convert to bytecode, and link an expression
821 %************************************************************************
825 compileExpr :: HscEnv
826 -> Module -> GlobalRdrEnv -> TypeEnv
830 compileExpr hsc_env this_mod rdr_env type_env tc_expr
831 = do { let { dflags = hsc_dflags hsc_env ;
832 lint_on = dopt Opt_DoCoreLinting dflags }
835 ; ds_expr <- deSugarExpr hsc_env this_mod rdr_env type_env tc_expr
838 ; flat_expr <- flattenExpr hsc_env ds_expr
841 ; simpl_expr <- simplifyExpr dflags flat_expr
843 -- Tidy it (temporary, until coreSat does cloning)
844 ; let tidy_expr = tidyExpr emptyTidyEnv simpl_expr
846 -- Prepare for codegen
847 ; prepd_expr <- corePrepExpr dflags tidy_expr
850 -- ToDo: improve SrcLoc
852 case lintUnfolding noSrcLoc [] prepd_expr of
853 Just err -> pprPanic "compileExpr" err
859 ; bcos <- coreExprToBCOs dflags prepd_expr
862 ; hval <- linkExpr hsc_env bcos
870 %************************************************************************
872 Statistics on reading interfaces
874 %************************************************************************
877 dumpIfaceStats :: HscEnv -> IO ()
878 dumpIfaceStats hsc_env
879 = do { eps <- readIORef (hsc_EPS hsc_env)
880 ; dumpIfSet (dump_if_trace || dump_rn_stats)
881 "Interface statistics"
884 dflags = hsc_dflags hsc_env
885 dump_rn_stats = dopt Opt_D_dump_rn_stats dflags
886 dump_if_trace = dopt Opt_D_dump_if_trace dflags
889 %************************************************************************
891 Progress Messages: Module i of n
893 %************************************************************************
896 showModuleIndex Nothing = ""
897 showModuleIndex (Just (i,n)) = "[" ++ padded ++ " of " ++ n_str ++ "] "
901 padded = replicate (length n_str - length i_str) ' ' ++ i_str