04c5b1e · haskell.nix · git.iko.soy

6062 -- condition (first parameter), or are dependencies of those

6063 -- modules. The second parameter is a condition to check before

6064diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs

6065−index 9bb6b4e391..e4dd13b9d7 100644

6065+index 9bb6b4e391..ce2b2f29b6 100644

6066--- a/compiler/main/HscMain.hs

6067+++ b/compiler/main/HscMain.hs

6068@@ -123,8 +123,10 @@ import MkIface

6076 import qualified GHC.StgToCmm as StgToCmm ( codeGen )

6077 import StgSyn

6078 import StgFVs ( annTopBindingsFreeVars )

6079+@@ -165,6 +167,8 @@ import Stream (Stream)

6080+ import Util

6081+

6082+ import Data.List ( nub, isPrefixOf, partition )

6083++import Data.Either ( partitionEithers )

6084++

6085+ import Control.Monad

6086+ import Data.IORef

6087+ import System.FilePath as FilePath

6079−@@ -1432,7 +1434,7 @@ hscGenHardCode hsc_env cgguts location output_filename = do

6088+@@ -1432,7 +1436,7 @@ hscGenHardCode hsc_env cgguts location output_filename = do

6080 ----------------- Convert to STG ------------------

6089 ----------------- Convert to STG ------------------

6081 (stg_binds, (caf_ccs, caf_cc_stacks))

6090 (stg_binds, (caf_ccs, caf_cc_stacks))

6082 <- {-# SCC "CoreToStg" #-}

6091 <- {-# SCC "CoreToStg" #-}

6085

6094

6086 let cost_centre_info =

6095 let cost_centre_info =

6087 (S.toList local_ccs ++ caf_ccs, caf_cc_stacks)

6096 (S.toList local_ccs ++ caf_ccs, caf_cc_stacks)

6088−@@ -1494,8 +1496,12 @@ hscInteractive hsc_env cgguts location = do

6097+@@ -1494,8 +1498,12 @@ hscInteractive hsc_env cgguts location = do

6089 -- Do saturation and convert to A-normal form

6098 -- Do saturation and convert to A-normal form

6090 (prepd_binds, _) <- {-# SCC "CorePrep" #-}

6099 (prepd_binds, _) <- {-# SCC "CorePrep" #-}

6091 corePrepPgm hsc_env this_mod location core_binds data_tycons

6100 corePrepPgm hsc_env this_mod location core_binds data_tycons

6099 ------------------ Create f-x-dynamic C-side stuff -----

6108 ------------------ Create f-x-dynamic C-side stuff -----

6100 (_istub_h_exists, istub_c_exists)

6109 (_istub_h_exists, istub_c_exists)

6101 <- outputForeignStubs dflags this_mod location foreign_stubs

6110 <- outputForeignStubs dflags this_mod location foreign_stubs

6102−@@ -1572,21 +1578,20 @@ doCodeGen hsc_env this_mod data_tycons

6111+@@ -1572,21 +1580,20 @@ doCodeGen hsc_env this_mod data_tycons

6103

6112

6104

6113

6105

6114

6125 {- **********************************************************************

6134 {- **********************************************************************

6126 %* *

6135 %* *

6127 \subsection{Compiling a do-statement}

6136 \subsection{Compiling a do-statement}

6128−@@ -1722,9 +1727,13 @@ hscParsedDecls hsc_env decls = runInteractiveHsc hsc_env $ do

6137+@@ -1722,9 +1729,13 @@ hscParsedDecls hsc_env decls = runInteractiveHsc hsc_env $ do

6129 (prepd_binds, _) <- {-# SCC "CorePrep" #-}

6138 (prepd_binds, _) <- {-# SCC "CorePrep" #-}

6130 liftIO $ corePrepPgm hsc_env this_mod iNTERACTIVELoc core_binds data_tycons

6139 liftIO $ corePrepPgm hsc_env this_mod iNTERACTIVELoc core_binds data_tycons

6131

6140

6149

6141 let src_span = srcLocSpan interactiveSrcLoc

6150 let src_span = srcLocSpan interactiveSrcLoc

6142 liftIO $ linkDecls hsc_env src_span cbc

6151 liftIO $ linkDecls hsc_env src_span cbc

6143−@@ -1887,9 +1896,20 @@ hscCompileCoreExpr' hsc_env srcspan ds_expr

6152+@@ -1887,9 +1898,38 @@ hscCompileCoreExpr' hsc_env srcspan ds_expr

6144 {- Lint if necessary -}

6153 {- Lint if necessary -}

6145 ; lintInteractiveExpr "hscCompileExpr" hsc_env prepd_expr

6154 ; lintInteractiveExpr "hscCompileExpr" hsc_env prepd_expr

6146

6155

6148+ ; let bco_tmp_id = mkSysLocal (fsLit "BCO_toplevel")

6157+ ; let bco_tmp_id = mkSysLocal (fsLit "BCO_toplevel")

6149+ (mkPseudoUniqueE 0)

6158+ (mkPseudoUniqueE 0)

6150+ (exprType prepd_expr)

6159+ (exprType prepd_expr)

6151−+ ; ([StgTopLifted (StgNonRec _ stg_expr)], _) <-

6160++ ; (binds, _) <-

6152+ myCoreToStg hsc_env

6161+ myCoreToStg hsc_env

6153+ (icInteractiveModule (hsc_IC hsc_env))

6162+ (icInteractiveModule (hsc_IC hsc_env))

6154+ [NonRec bco_tmp_id prepd_expr]

6163+ [NonRec bco_tmp_id prepd_expr]

6164++

6165++ ; let (_strings, lifted_binds) = partitionEithers $ do -- list monad

6166++ bnd <- binds

6167++ case bnd of

6168++ StgTopLifted (StgNonRec i expr) -> [Right (i, expr)]

6169++ StgTopLifted (StgRec bnds) -> map Right bnds

6170++ StgTopStringLit b str -> [Left (b, str)]

6171++

6172++ ; let stg_expr = case lifted_binds of

6173++ [(_i, e)] -> e

6174++ _ ->

6175++ StgRhsClosure noExtFieldSilent

6176++ dontCareCCS

6177++ ReEntrant

6178++ []

6179++ (StgLet noExtFieldSilent

6180++ (StgRec lifted_binds)

6181++ (StgApp bco_tmp_id []))

6155+

6182+

6156 {- Convert to BCOs -}

6183 {- Convert to BCOs -}

6157 ; bcos <- coreExprToBCOs hsc_env

6184 ; bcos <- coreExprToBCOs hsc_env