@@ -0,0 +1,76 @@
1+diff --git a/src/Development/IDE/Core/Compile.hs b/src/Development/IDE/Core/Compile.hs
2+index 99938bd4..471b184c 100644
3+--- a/src/Development/IDE/Core/Compile.hs
4++++ b/src/Development/IDE/Core/Compile.hs
5+@@ -122,6 +122,15 @@ import GHC.Hs (LEpaComment)
6+ import qualified GHC.Types.Error as Error
7+ #endif
8+
9++import StgSyn
10++import FastString
11++import Unique
12++import CostCentre
13++import Data.Either
14++import CoreSyn
15++import CoreToStg
16++import SimplStg
17++
18+ -- | Given a string buffer, return the string (after preprocessing) and the 'ParsedModule'.
19+ parseModule
20+ :: IdeOptions
21+@@ -256,9 +265,37 @@ captureSplicesAndDeps env k = do
22+ ; fv_hvs <- loadDecls (hscInterp hsc_env) hsc_env srcspan bcos
23+ ; let hval = (expectJust "hscCompileCoreExpr'" $ lookup (idName binding_id) fv_hvs)
24+ #else
25++ {- Create a temporary binding and convert to STG -}
26++ ; let bco_tmp_id = mkSysLocal (fsLit "BCO_toplevel")
27++ (mkPseudoUniqueE 0)
28++ (exprType prepd_expr)
29++ ; (binds, _) <-
30++ myCoreToStg hsc_env
31++ (icInteractiveModule (hsc_IC hsc_env))
32++ [NonRec bco_tmp_id prepd_expr]
33++
34++ ; let (_strings, lifted_binds) = partitionEithers $ do -- list monad
35++ bnd <- binds
36++ case bnd of
37++ StgTopLifted (StgNonRec i expr) -> [Right (i, expr)]
38++ StgTopLifted (StgRec bnds) -> map Right bnds
39++ StgTopStringLit b str -> [Left (b, str)]
40++
41++ ; let stg_expr = case lifted_binds of
42++ [(_i, e)] -> e
43++ _ ->
44++ StgRhsClosure noExtFieldSilent
45++ dontCareCCS
46++ ReEntrant
47++ []
48++ (StgLet noExtFieldSilent
49++ (StgRec lifted_binds)
50++ (StgApp bco_tmp_id []))
51+ {- Convert to BCOs -}
52+ ; bcos <- coreExprToBCOs hsc_env
53+- (icInteractiveModule (hsc_IC hsc_env)) prepd_expr
54++ (icInteractiveModule (hsc_IC hsc_env))
55++ bco_tmp_id
56++ stg_expr
57+
58+ ; let needed_mods = mkUniqSet [ moduleName mod | n <- uniqDSetToList (bcoFreeNames bcos)
59+ , Just mod <- [nameModule_maybe n] -- Names from other modules
60+@@ -1342,3 +1379,16 @@ pathToModuleName = mkModuleName . map rep
61+ rep c | isPathSeparator c = '_'
62+ rep ':' = '_'
63+ rep c = c
64++
65++myCoreToStg :: HscEnv -> Module -> CoreProgram
66++ -> IO ( [StgTopBinding] -- output program
67++ , CollectedCCs ) -- CAF cost centre info (declared and used)
68++myCoreToStg hsc_env this_mod prepd_binds = do
69++ let (stg_binds, cost_centre_info)
70++ = {-# SCC "Core2Stg" #-}
71++ coreToStg (hsc_dflags hsc_env) this_mod prepd_binds
72++ stg_binds2
73++ <- {-# SCC "Stg2Stg" #-}
74++ stg2stg hsc_env this_mod stg_binds
75++
76++ return (stg_binds2, cost_centre_info)