Commit 4905b83a authored by Simon Marlow's avatar Simon Marlow
Browse files

Remote GHCi, -fexternal-interpreter

Summary:
(Apologies for the size of this patch, I couldn't make a smaller one
that was validate-clean and also made sense independently)

(Some of this code is derived from GHCJS.)

This commit adds support for running interpreted code (for GHCi and
TemplateHaskell) in a separate process.  The functionality is
experimental, so for now it is off by default and enabled by the flag
-fexternal-interpreter.

Reaosns we want this:

* compiling Template Haskell code with -prof does not require
  building the code without -prof first

* when GHC itself is profiled, it can interpret unprofiled code, and
  the same applies to dynamic linking.  We would no longer need to
  force -dynamic-too with TemplateHaskell, and we can load ordinary
  objects into a dynamically-linked GHCi (and vice versa).

* An unprofiled GHCi can load and run profiled code, which means it
  can use the stack-trace functionality provided by profiling without
  taking the performance hit on the compiler that profiling would
  entail.

Amongst other things; see
https://ghc.haskell.org/trac/ghc/wiki/RemoteGHCi for more details.

Notes on the implementation are in Note [Remote GHCi] in the new
module compiler/ghci/GHCi.hs.  It probably needs more documenting,
feel free to suggest things I could elaborate on.

Things that are not currently implemented for -fexternal-interpreter:

* The GHCi debugger
* :set prog, :set args in GHCi
* `recover` in Template Haskell
* Redirecting stdin/stdout for the external process

These are all doable, I just wanted to get to a working validate-clean
patch first.

I also haven't done any benchmarking yet.  I expect there to be slight hit
to link times for byte code and some penalty due to having to
serialize/deserialize TH syntax, but I don't expect it to be a serious
problem.  There's also lots of low-hanging fruit in the byte code
generator/linker that we could exploit to speed things up.

Test Plan:
* validate
* I've run parts of the test suite with
EXTRA_HC_OPTS=-fexternal-interpreter, notably tests/ghci and tests/th.
There are a few failures due to the things not currently implemented
(see above).

Reviewers: simonpj, goldfire, ezyang, austin, alanz, hvr, niteria, bgamari, gibiansky, luite

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D1562
parent 7221ad70
...@@ -72,6 +72,7 @@ _darcs/ ...@@ -72,6 +72,7 @@ _darcs/
/ghc/stage1/ /ghc/stage1/
/ghc/stage2/ /ghc/stage2/
/ghc/stage3/ /ghc/stage3/
/iserv/stage2*/
# ----------------------------------------------------------------------------- # -----------------------------------------------------------------------------
# specific generated files # specific generated files
......
...@@ -467,7 +467,7 @@ AC_DEFUN([FP_SETTINGS], ...@@ -467,7 +467,7 @@ AC_DEFUN([FP_SETTINGS],
SettingsPerlCommand='$topdir/../perl/perl.exe' SettingsPerlCommand='$topdir/../perl/perl.exe'
SettingsDllWrapCommand="\$topdir/../${mingw_bin_prefix}dllwrap.exe" SettingsDllWrapCommand="\$topdir/../${mingw_bin_prefix}dllwrap.exe"
SettingsWindresCommand="\$topdir/../${mingw_bin_prefix}windres.exe" SettingsWindresCommand="\$topdir/../${mingw_bin_prefix}windres.exe"
SettingsTouchCommand='$topdir/touchy.exe' SettingsTouchCommand='$topdir/bin/touchy.exe'
else else
SettingsCCompilerCommand="$WhatGccIsCalled" SettingsCCompilerCommand="$WhatGccIsCalled"
SettingsHaskellCPPCommand="$HaskellCPPCmd" SettingsHaskellCPPCommand="$HaskellCPPCmd"
......
...@@ -86,8 +86,6 @@ module BasicTypes( ...@@ -86,8 +86,6 @@ module BasicTypes(
FractionalLit(..), negateFractionalLit, integralFractionalLit, FractionalLit(..), negateFractionalLit, integralFractionalLit,
HValue(..),
SourceText, SourceText,
IntWithInf, infinity, treatZeroAsInf, mkIntWithInf, intGtLimit IntWithInf, infinity, treatZeroAsInf, mkIntWithInf, intGtLimit
...@@ -99,7 +97,6 @@ import SrcLoc ( Located,unLoc ) ...@@ -99,7 +97,6 @@ import SrcLoc ( Located,unLoc )
import StaticFlags( opt_PprStyle_Debug ) import StaticFlags( opt_PprStyle_Debug )
import Data.Data hiding (Fixity) import Data.Data hiding (Fixity)
import Data.Function (on) import Data.Function (on)
import GHC.Exts (Any)
{- {-
************************************************************************ ************************************************************************
...@@ -1165,8 +1162,6 @@ instance Ord FractionalLit where ...@@ -1165,8 +1162,6 @@ instance Ord FractionalLit where
instance Outputable FractionalLit where instance Outputable FractionalLit where
ppr = text . fl_text ppr = text . fl_text
newtype HValue = HValue Any
{- {-
************************************************************************ ************************************************************************
* * * *
......
...@@ -106,13 +106,13 @@ data Literal ...@@ -106,13 +106,13 @@ data Literal
(Maybe Int) (Maybe Int)
FunctionOrData FunctionOrData
-- ^ A label literal. Parameters: -- ^ A label literal. Parameters:
-- --
-- 1) The name of the symbol mentioned in the declaration -- 1) The name of the symbol mentioned in the declaration
-- --
-- 2) The size (in bytes) of the arguments -- 2) The size (in bytes) of the arguments
-- the label expects. Only applicable with -- the label expects. Only applicable with
-- @stdcall@ labels. @Just x@ => @\<x\>@ will -- @stdcall@ labels. @Just x@ => @\<x\>@ will
-- be appended to label name when emitting assembly. -- be appended to label name when emitting assembly.
| LitInteger Integer Type -- ^ Integer literals | LitInteger Integer Type -- ^ Integer literals
-- See Note [Integer literals] -- See Note [Integer literals]
......
...@@ -278,15 +278,16 @@ mkStringExprFS str ...@@ -278,15 +278,16 @@ mkStringExprFS str
| all safeChar chars | all safeChar chars
= do unpack_id <- lookupId unpackCStringName = do unpack_id <- lookupId unpackCStringName
return (App (Var unpack_id) (Lit (MachStr (fastStringToByteString str)))) return (App (Var unpack_id) lit)
| otherwise | otherwise
= do unpack_id <- lookupId unpackCStringUtf8Name = do unpack_utf8_id <- lookupId unpackCStringUtf8Name
return (App (Var unpack_id) (Lit (MachStr (fastStringToByteString str)))) return (App (Var unpack_utf8_id) lit)
where where
chars = unpackFS str chars = unpackFS str
safeChar c = ord c >= 1 && ord c <= 0x7F safeChar c = ord c >= 1 && ord c <= 0x7F
lit = Lit (MachStr (fastStringToByteString str))
{- {-
************************************************************************ ************************************************************************
......
...@@ -981,7 +981,9 @@ data TickishType = ProfNotes | HpcTicks | Breakpoints | SourceNotes ...@@ -981,7 +981,9 @@ data TickishType = ProfNotes | HpcTicks | Breakpoints | SourceNotes
coveragePasses :: DynFlags -> [TickishType] coveragePasses :: DynFlags -> [TickishType]
coveragePasses dflags = coveragePasses dflags =
ifa (hscTarget dflags == HscInterpreted) Breakpoints $ ifa (hscTarget dflags == HscInterpreted &&
not (gopt Opt_ExternalInterpreter dflags)) Breakpoints $
-- TODO: breakpoints don't work with -fexternal-interpreter yet
ifa (gopt Opt_Hpc dflags) HpcTicks $ ifa (gopt Opt_Hpc dflags) HpcTicks $
ifa (gopt Opt_SccProfilingOn dflags && ifa (gopt Opt_SccProfilingOn dflags &&
profAuto dflags /= NoProfAuto) ProfNotes $ profAuto dflags /= NoProfAuto) ProfNotes $
......
...@@ -64,6 +64,9 @@ Library ...@@ -64,6 +64,9 @@ Library
else else
Build-Depends: unix Build-Depends: unix
if flag(ghci)
Build-Depends: ghci
GHC-Options: -Wall -fno-warn-name-shadowing GHC-Options: -Wall -fno-warn-name-shadowing
if flag(ghci) if flag(ghci)
...@@ -467,7 +470,6 @@ Library ...@@ -467,7 +470,6 @@ Library
Pair Pair
Panic Panic
Pretty Pretty
Serialized
State State
Stream Stream
StringBuffer StringBuffer
...@@ -578,6 +580,7 @@ Library ...@@ -578,6 +580,7 @@ Library
if flag(ghci) if flag(ghci)
Exposed-Modules: Exposed-Modules:
Convert Convert
ByteCodeTypes
ByteCodeAsm ByteCodeAsm
ByteCodeGen ByteCodeGen
ByteCodeInstr ByteCodeInstr
...@@ -586,6 +589,6 @@ Library ...@@ -586,6 +589,6 @@ Library
Debugger Debugger
LibFFI LibFFI
Linker Linker
ObjLink
RtClosureInspect RtClosureInspect
DebuggerUtils DebuggerUtils
GHCi
...@@ -580,7 +580,6 @@ compiler_stage2_dll0_MODULES = \ ...@@ -580,7 +580,6 @@ compiler_stage2_dll0_MODULES = \
PrimOp \ PrimOp \
RdrName \ RdrName \
Rules \ Rules \
Serialized \
SrcLoc \ SrcLoc \
StaticFlags \ StaticFlags \
StringBuffer \ StringBuffer \
...@@ -609,49 +608,8 @@ ifeq "$(GhcWithInterpreter)" "YES" ...@@ -609,49 +608,8 @@ ifeq "$(GhcWithInterpreter)" "YES"
# These files are reacheable from DynFlags # These files are reacheable from DynFlags
# only by GHCi-enabled code (see #9552) # only by GHCi-enabled code (see #9552)
compiler_stage2_dll0_MODULES += \ compiler_stage2_dll0_MODULES += \
Bitmap \ ByteCodeTypes \
BlockId \ InteractiveEvalTypes
ByteCodeAsm \
ByteCodeInstr \
ByteCodeItbls \
CLabel \
Cmm \
CmmCallConv \
CmmExpr \
CmmInfo \
CmmMachOp \
CmmNode \
CmmSwitch \
CmmUtils \
CodeGen.Platform \
CodeGen.Platform.ARM \
CodeGen.Platform.ARM64 \
CodeGen.Platform.NoRegs \
CodeGen.Platform.PPC \
CodeGen.Platform.PPC_Darwin \
CodeGen.Platform.SPARC \
CodeGen.Platform.X86 \
CodeGen.Platform.X86_64 \
Hoopl \
Hoopl.Dataflow \
InteractiveEvalTypes \
MkGraph \
PprCmm \
PprCmmDecl \
PprCmmExpr \
Reg \
RegClass \
SMRep \
StgCmmArgRep \
StgCmmClosure \
StgCmmEnv \
StgCmmLayout \
StgCmmMonad \
StgCmmProf \
StgCmmTicky \
StgCmmUtils \
StgSyn \
Stream
endif endif
compiler_stage2_dll0_HS_OBJS = \ compiler_stage2_dll0_HS_OBJS = \
...@@ -769,4 +727,3 @@ ghc/stage1/package-data.mk : compiler/stage1/inplace-pkg-config-munged ...@@ -769,4 +727,3 @@ ghc/stage1/package-data.mk : compiler/stage1/inplace-pkg-config-munged
endif endif
endif endif
...@@ -8,8 +8,7 @@ ...@@ -8,8 +8,7 @@
module ByteCodeAsm ( module ByteCodeAsm (
assembleBCOs, assembleBCO, assembleBCOs, assembleBCO,
CompiledByteCode(..), bcoFreeNames,
UnlinkedBCO(..), BCOPtr(..), BCONPtr(..), bcoFreeNames,
SizedSeq, sizeSS, ssElts, SizedSeq, sizeSS, ssElts,
iNTERP_STACK_CHECK_THRESH iNTERP_STACK_CHECK_THRESH
) where ) where
...@@ -18,12 +17,13 @@ module ByteCodeAsm ( ...@@ -18,12 +17,13 @@ module ByteCodeAsm (
import ByteCodeInstr import ByteCodeInstr
import ByteCodeItbls import ByteCodeItbls
import ByteCodeTypes
import HscTypes
import Name import Name
import NameSet import NameSet
import Literal import Literal
import TyCon import TyCon
import PrimOp
import FastString import FastString
import StgCmmLayout ( ArgRep(..) ) import StgCmmLayout ( ArgRep(..) )
import SMRep import SMRep
...@@ -32,6 +32,9 @@ import Outputable ...@@ -32,6 +32,9 @@ import Outputable
import Platform import Platform
import Util import Util
-- From iserv
import SizedSeq
#if __GLASGOW_HASKELL__ < 709 #if __GLASGOW_HASKELL__ < 709
import Control.Applicative (Applicative(..)) import Control.Applicative (Applicative(..))
#endif #endif
...@@ -47,6 +50,7 @@ import Data.Array.Base ( UArray(..) ) ...@@ -47,6 +50,7 @@ import Data.Array.Base ( UArray(..) )
import Data.Array.Unsafe( castSTUArray ) import Data.Array.Unsafe( castSTUArray )
import qualified Data.ByteString as B
import Foreign import Foreign
import Data.Char ( ord ) import Data.Char ( ord )
import Data.List import Data.List
...@@ -54,44 +58,12 @@ import Data.Map (Map) ...@@ -54,44 +58,12 @@ import Data.Map (Map)
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
import qualified Data.Map as Map import qualified Data.Map as Map
import GHC.Base ( ByteArray#, MutableByteArray#, RealWorld )
-- ----------------------------------------------------------------------------- -- -----------------------------------------------------------------------------
-- Unlinked BCOs -- Unlinked BCOs
-- CompiledByteCode represents the result of byte-code -- CompiledByteCode represents the result of byte-code
-- compiling a bunch of functions and data types -- compiling a bunch of functions and data types
data CompiledByteCode
= ByteCode [UnlinkedBCO] -- Bunch of interpretable bindings
ItblEnv -- A mapping from DataCons to their itbls
instance Outputable CompiledByteCode where
ppr (ByteCode bcos _) = ppr bcos
data UnlinkedBCO
= UnlinkedBCO {
unlinkedBCOName :: Name,
unlinkedBCOArity :: Int,
unlinkedBCOInstrs :: ByteArray#, -- insns
unlinkedBCOBitmap :: ByteArray#, -- bitmap
unlinkedBCOLits :: (SizedSeq BCONPtr), -- non-ptrs
unlinkedBCOPtrs :: (SizedSeq BCOPtr) -- ptrs
}
data BCOPtr
= BCOPtrName Name
| BCOPtrPrimOp PrimOp
| BCOPtrBCO UnlinkedBCO
| BCOPtrBreakInfo BreakInfo
| BCOPtrArray (MutableByteArray# RealWorld)
data BCONPtr
= BCONPtrWord Word
| BCONPtrLbl FastString
| BCONPtrItbl Name
-- | Finds external references. Remember to remove the names -- | Finds external references. Remember to remove the names
-- defined by this group of BCOs themselves -- defined by this group of BCOs themselves
bcoFreeNames :: UnlinkedBCO -> NameSet bcoFreeNames :: UnlinkedBCO -> NameSet
...@@ -105,12 +77,6 @@ bcoFreeNames bco ...@@ -105,12 +77,6 @@ bcoFreeNames bco
map bco_refs [ bco | BCOPtrBCO bco <- ssElts ptrs ] map bco_refs [ bco | BCOPtrBCO bco <- ssElts ptrs ]
) )
instance Outputable UnlinkedBCO where
ppr (UnlinkedBCO nm _arity _insns _bitmap lits ptrs)
= sep [text "BCO", ppr nm, text "with",
ppr (sizeSS lits), text "lits",
ppr (sizeSS ptrs), text "ptrs" ]
-- ----------------------------------------------------------------------------- -- -----------------------------------------------------------------------------
-- The bytecode assembler -- The bytecode assembler
...@@ -122,11 +88,11 @@ instance Outputable UnlinkedBCO where ...@@ -122,11 +88,11 @@ instance Outputable UnlinkedBCO where
-- bytecode address in this BCO. -- bytecode address in this BCO.
-- Top level assembler fn. -- Top level assembler fn.
assembleBCOs :: DynFlags -> [ProtoBCO Name] -> [TyCon] -> IO CompiledByteCode assembleBCOs :: HscEnv -> [ProtoBCO Name] -> [TyCon] -> IO CompiledByteCode
assembleBCOs dflags proto_bcos tycons assembleBCOs hsc_env proto_bcos tycons = do
= do itblenv <- mkITbls dflags tycons itblenv <- mkITbls hsc_env tycons
bcos <- mapM (assembleBCO dflags) proto_bcos bcos <- mapM (assembleBCO (hsc_dflags hsc_env)) proto_bcos
return (ByteCode bcos itblenv) return (ByteCode bcos itblenv (concat (map protoBCOFFIs proto_bcos)))
assembleBCO :: DynFlags -> ProtoBCO Name -> IO UnlinkedBCO assembleBCO :: DynFlags -> ProtoBCO Name -> IO UnlinkedBCO
assembleBCO dflags (ProtoBCO nm instrs bitmap bsize arity _origin _malloced) = do assembleBCO dflags (ProtoBCO nm instrs bitmap bsize arity _origin _malloced) = do
...@@ -161,15 +127,9 @@ assembleBCO dflags (ProtoBCO nm instrs bitmap bsize arity _origin _malloced) = d ...@@ -161,15 +127,9 @@ assembleBCO dflags (ProtoBCO nm instrs bitmap bsize arity _origin _malloced) = d
ASSERT(n_insns == sizeSS final_insns) return () ASSERT(n_insns == sizeSS final_insns) return ()
let asm_insns = ssElts final_insns let asm_insns = ssElts final_insns
barr a = case a of UArray _lo _hi _n b -> b insns_arr = Array.listArray (0, fromIntegral n_insns - 1) asm_insns
insns_arr = Array.listArray (0, n_insns - 1) asm_insns
!insns_barr = barr insns_arr
bitmap_arr = mkBitmapArray bsize bitmap bitmap_arr = mkBitmapArray bsize bitmap
!bitmap_barr = barr bitmap_arr ul_bco = UnlinkedBCO nm arity insns_arr bitmap_arr final_lits final_ptrs
ul_bco = UnlinkedBCO nm arity insns_barr bitmap_barr final_lits final_ptrs
-- 8 Aug 01: Finalisers aren't safe when attached to non-primitive -- 8 Aug 01: Finalisers aren't safe when attached to non-primitive
-- objects, since they might get run too early. Disable this until -- objects, since they might get run too early. Disable this until
...@@ -191,23 +151,6 @@ type AsmState = (SizedSeq Word16, ...@@ -191,23 +151,6 @@ type AsmState = (SizedSeq Word16,
SizedSeq BCONPtr, SizedSeq BCONPtr,
SizedSeq BCOPtr) SizedSeq BCOPtr)
data SizedSeq a = SizedSeq !Word [a]
emptySS :: SizedSeq a
emptySS = SizedSeq 0 []
addToSS :: SizedSeq a -> a -> SizedSeq a
addToSS (SizedSeq n r_xs) x = SizedSeq (n+1) (x:r_xs)
addListToSS :: SizedSeq a -> [a] -> SizedSeq a
addListToSS (SizedSeq n r_xs) xs
= SizedSeq (n + genericLength xs) (reverse xs ++ r_xs)
ssElts :: SizedSeq a -> [a]
ssElts (SizedSeq _ r_xs) = reverse r_xs
sizeSS :: SizedSeq a -> Word
sizeSS (SizedSeq n _) = n
data Operand data Operand
= Op Word = Op Word
| SmallOp Word16 | SmallOp Word16
...@@ -365,9 +308,7 @@ assembleI dflags i = case i of ...@@ -365,9 +308,7 @@ assembleI dflags i = case i of
-> do let ul_bco = assembleBCO dflags proto -> do let ul_bco = assembleBCO dflags proto
p <- ioptr (liftM BCOPtrBCO ul_bco) p <- ioptr (liftM BCOPtrBCO ul_bco)
emit (push_alts pk) [Op p] emit (push_alts pk) [Op p]
PUSH_UBX (Left lit) nws -> do np <- literal lit PUSH_UBX lit nws -> do np <- literal lit
emit bci_PUSH_UBX [Op np, SmallOp nws]
PUSH_UBX (Right aa) nws -> do np <- addr aa
emit bci_PUSH_UBX [Op np, SmallOp nws] emit bci_PUSH_UBX [Op np, SmallOp nws]
PUSH_APPLY_N -> emit bci_PUSH_APPLY_N [] PUSH_APPLY_N -> emit bci_PUSH_APPLY_N []
...@@ -437,7 +378,9 @@ assembleI dflags i = case i of ...@@ -437,7 +378,9 @@ assembleI dflags i = case i of
literal (MachChar c) = int (ord c) literal (MachChar c) = int (ord c)
literal (MachInt64 ii) = int64 (fromIntegral ii) literal (MachInt64 ii) = int64 (fromIntegral ii)
literal (MachWord64 ii) = int64 (fromIntegral ii) literal (MachWord64 ii) = int64 (fromIntegral ii)
literal other = pprPanic "ByteCodeAsm.literal" (ppr other) literal (MachStr bs) = lit [BCONPtrStr (bs `B.snoc` 0)]
-- MachStr requires a zero-terminator when emitted
literal LitInteger{} = panic "ByteCodeAsm.literal: LitInteger"
litlabel fs = lit [BCONPtrLbl fs] litlabel fs = lit [BCONPtrLbl fs]
addr = words . mkLitPtr addr = words . mkLitPtr
......
...@@ -9,11 +9,13 @@ module ByteCodeGen ( UnlinkedBCO, byteCodeGen, coreExprToBCOs ) where ...@@ -9,11 +9,13 @@ module ByteCodeGen ( UnlinkedBCO, byteCodeGen, coreExprToBCOs ) where
#include "HsVersions.h" #include "HsVersions.h"
import ByteCodeInstr import ByteCodeInstr
import ByteCodeItbls
import ByteCodeAsm import ByteCodeAsm
import ByteCodeLink import ByteCodeTypes
import LibFFI
import GHCi
import GHCi.FFI
import GHCi.RemoteTypes
import BasicTypes
import DynFlags import DynFlags
import Outputable import Outputable
import Platform import Platform
...@@ -45,7 +47,6 @@ import OrdList ...@@ -45,7 +47,6 @@ import OrdList
import Data.List import Data.List
import Foreign import Foreign
import Foreign.C
#if __GLASGOW_HASKELL__ < 709 #if __GLASGOW_HASKELL__ < 709
import Control.Applicative (Applicative(..)) import Control.Applicative (Applicative(..))
...@@ -59,8 +60,6 @@ import Data.Maybe ...@@ -59,8 +60,6 @@ import Data.Maybe
import Module import Module
import Control.Arrow ( second ) import Control.Arrow ( second )
import qualified Data.ByteString as BS
import qualified Data.ByteString.Unsafe as BS
import Data.Map (Map) import Data.Map (Map)
import qualified Data.Map as Map import qualified Data.Map as Map
import qualified FiniteMap as Map import qualified FiniteMap as Map
...@@ -69,42 +68,43 @@ import Data.Ord ...@@ -69,42 +68,43 @@ import Data.Ord
-- ----------------------------------------------------------------------------- -- -----------------------------------------------------------------------------
-- Generating byte code for a complete module -- Generating byte code for a complete module
byteCodeGen :: DynFlags byteCodeGen :: HscEnv
-> Module -> Module
-> CoreProgram -> CoreProgram
-> [TyCon] -> [TyCon]
-> ModBreaks -> ModBreaks
-> IO CompiledByteCode -> IO CompiledByteCode
byteCodeGen dflags this_mod binds tycs modBreaks byteCodeGen hsc_env this_mod binds tycs modBreaks
= do showPass dflags "ByteCodeGen" = do let dflags = hsc_dflags hsc_env
showPass dflags "ByteCodeGen"
let flatBinds = [ (bndr, simpleFreeVars rhs) let flatBinds = [ (bndr, simpleFreeVars rhs)
| (bndr, rhs) <- flattenBinds binds] | (bndr, rhs) <- flattenBinds binds]
us <- mkSplitUniqSupply 'y' us <- mkSplitUniqSupply 'y'
(BcM_State _dflags _us _this_mod _final_ctr mallocd _, proto_bcos) (BcM_State _hsc_env _us _this_mod _final_ctr ffis _, proto_bcos)
<- runBc dflags us this_mod modBreaks (mapM schemeTopBind flatBinds) <- runBc hsc_env us this_mod modBreaks (mapM schemeTopBind flatBinds)
when (notNull mallocd) when (notNull ffis)
(panic "ByteCodeGen.byteCodeGen: missing final emitBc?") (panic "ByteCodeGen.byteCodeGen: missing final emitBc?")
dumpIfSet_dyn dflags Opt_D_dump_BCOs dumpIfSet_dyn dflags Opt_D_dump_BCOs
"Proto-BCOs" (vcat (intersperse (char ' ') (map ppr proto_bcos))) "Proto-BCOs" (vcat (intersperse (char ' ') (map ppr proto_bcos)))
assembleBCOs dflags proto_bcos tycs assembleBCOs hsc_env proto_bcos tycs
where
-- ----------------------------------------------------------------------------- -- -----------------------------------------------------------------------------
-- Generating byte code for an expression -- Generating byte code for an expression
-- Returns: (the root BCO for this expression, -- Returns: (the root BCO for this expression,
-- a list of auxilary BCOs resulting from compiling closures) -- a list of auxilary BCOs resulting from compiling closures)
coreExprToBCOs :: DynFlags coreExprToBCOs :: HscEnv
-> Module -> Module