|
| 1 | +diff --git a/src/Development/IDE/Core/Compile.hs b/src/Development/IDE/Core/Compile.hs |
| 2 | +index 2b355639..84b77e8a 100644 |
| 3 | +--- a/src/Development/IDE/Core/Compile.hs |
| 4 | ++++ b/src/Development/IDE/Core/Compile.hs |
| 5 | +@@ -154,6 +154,15 @@ import GHC.Driver.Config.CoreToStg.Prep |
| 6 | + import GHC.Core.Lint.Interactive |
| 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 | + --Simple constants to make sure the source is consistently named |
| 19 | + sourceTypecheck :: T.Text |
| 20 | + sourceTypecheck = "typecheck" |
| 21 | +@@ -294,9 +303,38 @@ captureSplicesAndDeps TypecheckHelpers{..} env k = do |
| 22 | + stg_expr |
| 23 | + [] Nothing |
| 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 | ++ |
| 52 | + {- Convert to BCOs -} |
| 53 | + ; bcos <- coreExprToBCOs hsc_env |
| 54 | +- (icInteractiveModule (hsc_IC hsc_env)) prepd_expr |
| 55 | ++ (icInteractiveModule (hsc_IC hsc_env)) |
| 56 | ++ bco_tmp_id |
| 57 | ++ stg_expr |
| 58 | + #endif |
| 59 | + |
| 60 | + -- Exclude wired-in names because we may not have read |
| 61 | +@@ -1747,6 +1785,19 @@ pathToModuleName = mkModuleName . map rep |
| 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) |
| 77 | ++ |
| 78 | + {- Note [Guidelines For Using CPP In GHCIDE Import Statements] |
| 79 | + GHCIDE's interface with GHC is extensive, and unfortunately, because we have |
| 80 | + to work with multiple versions of GHC, we have several files that need to use |
0 commit comments