import Linker ( HValue, linkExpr )
import CoreTidy ( tidyExpr )
import CorePrep ( corePrepExpr )
-import Flattening ( flattenExpr )
import Desugar ( deSugarExpr )
import SimplCore ( simplifyExpr )
import TcRnDriver ( tcRnStmt, tcRnExpr, tcRnType )
import Parser
import Lexer
import SrcLoc ( mkSrcLoc )
-import TcRnDriver ( tcRnModule, tcRnExtCore )
+import TcRnDriver ( tcRnModule )
import TcIface ( typecheckIface )
import TcRnMonad ( initIfaceCheck, TcGblEnv(..) )
import IfaceEnv ( initNameCache )
import HscStats ( ppSourceStats )
import HscTypes
import MkExternalCore ( emitExternalCore )
-import ParserCore
-import ParserCoreUtils
import FastString
import LazyUniqFM ( emptyUFM )
import UniqSupply ( initUs_ )
genComp backend boot_backend = do
mod_summary <- gets compModSummary
case ms_hsc_src mod_summary of
- ExtCoreFile -> do
- mb_modguts <- hscCoreFrontEnd
- case mb_modguts of
- Nothing -> return Nothing
- Just guts -> backend guts
+ ExtCoreFile -> do
+ panic "GHC does not currently support reading External Core files"
_not_core -> do
mb_tc <- hscFileFrontEnd
case mb_tc of
--------------------------------------------------------------
-- FrontEnds
--------------------------------------------------------------
-
-hscCoreFrontEnd :: Comp (Maybe ModGuts)
-hscCoreFrontEnd =
- do hsc_env <- gets compHscEnv
- mod_summary <- gets compModSummary
- liftIO $ do
- -------------------
- -- PARSE
- -------------------
- inp <- readFile (ms_hspp_file mod_summary)
- case parseCore inp 1 of
- FailP s
- -> do errorMsg (hsc_dflags hsc_env) (text s{-ToDo: wrong-})
- return Nothing
- OkP rdr_module
- -------------------
- -- RENAME and TYPECHECK
- -------------------
- -> do (tc_msgs, maybe_tc_result) <- {-# SCC "TypeCheck" #-}
- tcRnExtCore hsc_env rdr_module
- printErrorsAndWarnings (hsc_dflags hsc_env) tc_msgs
- case maybe_tc_result of
- Nothing -> return Nothing
- Just mod_guts -> return (Just mod_guts) -- No desugaring to do!
-
-
hscFileFrontEnd :: Comp (Maybe TcGblEnv)
hscFileFrontEnd =
do hsc_env <- gets compHscEnv
<- {-# SCC "MkFinalIface" #-}
mkIface hsc_env maybe_old_iface details simpl_result
-- Emit external core
- emitExternalCore (hsc_dflags hsc_env) (availsToNameSet (mg_exports simpl_result)) cg_guts -- Move this? --Lemmih 03/07/2006
+ -- This should definitely be here and not after CorePrep,
+ -- because CorePrep produces unqualified constructor wrapper declarations,
+ -- so its output isn't valid External Core (without some preprocessing).
+ emitExternalCore (hsc_dflags hsc_env) cg_guts
dumpIfaceStats hsc_env
-------------------
= do { let { dflags = hsc_dflags hsc_env ;
lint_on = dopt Opt_DoCoreLinting dflags }
- -- Flatten it
- ; flat_expr <- flattenExpr hsc_env ds_expr
-
-- Simplify it
- ; simpl_expr <- simplifyExpr dflags flat_expr
+ ; simpl_expr <- simplifyExpr dflags ds_expr
-- Tidy it (temporary, until coreSat does cloning)
; let tidy_expr = tidyExpr emptyTidyEnv simpl_expr