ghci 8.0.2 → 8.2.1

raw patch · 12 files changed

+469/−186 lines, 12 filesdep +ghc-boot-thdep ~basedep ~ghc-bootdep ~template-haskellPVP ok

version bump matches the API change (PVP)

Dependencies added: ghc-boot-th

Dependency ranges changed: base, ghc-boot, template-haskell

API changes (from Hackage documentation)

Files

• GHCi/BreakArray.hs +6/−0
• GHCi/CreateBCO.hs +1/−0
• GHCi/InfoTable.hsc +65/−60
• GHCi/Message.hs +164/−80
• GHCi/ObjLink.hs +41/−5
• GHCi/RemoteTypes.hs +8/−0
• GHCi/Run.hs +7/−15
• GHCi/StaticPtrTable.hs +24/−0
• GHCi/TH.hs +103/−8
• GHCi/TH/Binary.hs +20/−6
• changelog.md +10/−0
• ghci.cabal +20/−12

@@ -19,14 +19,17 @@ module GHCi.BreakArray     (       BreakArray+#ifdef GHCI           (BA) -- constructor is exported only for ByteCodeGen     , newBreakArray     , getBreak     , setBreakOn     , setBreakOff     , showBreakArray+#endif     ) where +#ifdef GHCI import Control.Monad import Data.Word import GHC.Word@@ -112,3 +115,6 @@  readBreakArray :: BreakArray -> Int -> IO Word8 readBreakArray (BA array) (I# i) = readBA# array i+#else+data BreakArray+#endif

@@ -10,6 +10,7 @@ --  (c) The University of Glasgow 2002-2006 -- +-- | Create real byte-code objects from 'ResolvedBCO's. module GHCi.CreateBCO (createBCOs) where  import GHCi.ResolvedBCO

@@ -6,9 +6,11 @@ -- We use the RTS data structures directly via hsc2hs. -- module GHCi.InfoTable-  ( mkConInfoTable-  , peekItbl, StgInfoTable(..)+  ( peekItbl, StgInfoTable(..)   , conInfoPtr+#ifdef GHCI+  , mkConInfoTable+#endif   ) where  #if !defined(TABLES_NEXT_TO_CODE)@@ -20,6 +22,66 @@ import GHC.Exts import System.IO.Unsafe +type ItblCodes = Either [Word8] [Word32]++-- Get definitions for the structs, constants & config etc.+#include "Rts.h"++-- Ultra-minimalist version specially for constructors+#if SIZEOF_VOID_P == 8+type HalfWord = Word32+#elif SIZEOF_VOID_P == 4+type HalfWord = Word16+#else+#error Uknown SIZEOF_VOID_P+#endif++type EntryFunPtr = FunPtr (Ptr () -> IO (Ptr ()))++data StgInfoTable = StgInfoTable {+   entry  :: Maybe EntryFunPtr, -- Just <=> not ghciTablesNextToCode+   ptrs   :: HalfWord,+   nptrs  :: HalfWord,+   tipe   :: HalfWord,+   srtlen :: HalfWord,+   code   :: Maybe ItblCodes -- Just <=> ghciTablesNextToCode+  }++peekItbl :: Ptr StgInfoTable -> IO StgInfoTable+peekItbl a0 = do+#if defined(TABLES_NEXT_TO_CODE)+  let entry' = Nothing+#else+  entry' <- Just <$> (#peek StgInfoTable, entry) a0+#endif+  ptrs' <- (#peek StgInfoTable, layout.payload.ptrs) a0+  nptrs' <- (#peek StgInfoTable, layout.payload.nptrs) a0+  tipe' <- (#peek StgInfoTable, type) a0+  srtlen' <- (#peek StgInfoTable, srt_bitmap) a0+  return StgInfoTable+    { entry  = entry'+    , ptrs   = ptrs'+    , nptrs  = nptrs'+    , tipe   = tipe'+    , srtlen = srtlen'+    , code   = Nothing+    }++-- | Convert a pointer to an StgConInfo into an info pointer that can be+-- used in the header of a closure.+conInfoPtr :: Ptr () -> Ptr ()+conInfoPtr ptr+ | ghciTablesNextToCode = ptr `plusPtr` (#size StgConInfoTable)+ | otherwise            = ptr++ghciTablesNextToCode :: Bool+#ifdef TABLES_NEXT_TO_CODE+ghciTablesNextToCode = True+#else+ghciTablesNextToCode = False+#endif++#ifdef GHCI /* To end */ mkConInfoTable    :: Int     -- ptr words    -> Int     -- non-ptr words@@ -52,8 +114,6 @@ -- ----------------------------------------------------------------------------- -- Building machine code fragments for a constructor's entry code -type ItblCodes = Either [Word8] [Word32]- funPtrToInt :: FunPtr a -> Int funPtrToInt (FunPtr a) = I## (addr2Int## a) @@ -280,9 +340,6 @@ -- ----------------------------------------------------------------------------- -- read & write intfo tables --- Get definitions for the structs, constants & config etc.-#include "Rts.h"- -- entry point for direct returns for created constr itbls foreign import ccall "&stg_interp_constr1_entry" stg_interp_constr1_entry :: EntryFunPtr foreign import ccall "&stg_interp_constr2_entry" stg_interp_constr2_entry :: EntryFunPtr@@ -302,31 +359,12 @@                     , stg_interp_constr6_entry                     , stg_interp_constr7_entry ] --- Ultra-minimalist version specially for constructors-#if SIZEOF_VOID_P == 8-type HalfWord = Word32-#elif SIZEOF_VOID_P == 4-type HalfWord = Word16-#else-#error Uknown SIZEOF_VOID_P-#endif- data StgConInfoTable = StgConInfoTable {    conDesc   :: Ptr Word8,    infoTable :: StgInfoTable } -type EntryFunPtr = FunPtr (Ptr () -> IO (Ptr ())) -data StgInfoTable = StgInfoTable {-   entry  :: Maybe EntryFunPtr, -- Just <=> not ghciTablesNextToCode-   ptrs   :: HalfWord,-   nptrs  :: HalfWord,-   tipe   :: HalfWord,-   srtlen :: HalfWord,-   code   :: Maybe ItblCodes -- Just <=> ghciTablesNextToCode-  }- pokeConItbl   :: Ptr StgConInfoTable -> Ptr StgConInfoTable -> StgConInfoTable   -> IO ()@@ -364,26 +402,6 @@     Just (Right xs) -> pokeArray code_offset xs #endif -peekItbl :: Ptr StgInfoTable -> IO StgInfoTable-peekItbl a0 = do-#if defined(TABLES_NEXT_TO_CODE)-  let entry' = Nothing-#else-  entry' <- Just <$> (#peek StgInfoTable, entry) a0-#endif-  ptrs' <- (#peek StgInfoTable, layout.payload.ptrs) a0-  nptrs' <- (#peek StgInfoTable, layout.payload.nptrs) a0-  tipe' <- (#peek StgInfoTable, type) a0-  srtlen' <- (#peek StgInfoTable, srt_bitmap) a0-  return StgInfoTable-    { entry  = entry'-    , ptrs   = ptrs'-    , nptrs  = nptrs'-    , tipe   = tipe'-    , srtlen = srtlen'-    , code   = Nothing-    }- newExecConItbl :: StgInfoTable -> [Word8] -> IO (FunPtr ()) newExecConItbl obj con_desc    = alloca $ \pcode -> do@@ -408,13 +426,6 @@ foreign import ccall unsafe "flushExec"   _flushExec :: CUInt -> Ptr a -> IO () --- | Convert a pointer to an StgConInfo into an info pointer that can be--- used in the header of a closure.-conInfoPtr :: Ptr () -> Ptr ()-conInfoPtr ptr- | ghciTablesNextToCode = ptr `plusPtr` (#size StgConInfoTable)- | otherwise            = ptr- -- ----------------------------------------------------------------------------- -- Constants and config @@ -443,10 +454,4 @@  cONSTR :: Int   -- Defined in ClosureTypes.h cONSTR = (#const CONSTR)--ghciTablesNextToCode :: Bool-#ifdef TABLES_NEXT_TO_CODE-ghciTablesNextToCode = True-#else-ghciTablesNextToCode = False-#endif+#endif /* GHCI */

@@ -1,16 +1,26 @@-{-# LANGUAGE GADTs, DeriveGeneric, StandaloneDeriving,-    GeneralizedNewtypeDeriving, ExistentialQuantification, RecordWildCards #-}+{-# LANGUAGE GADTs, DeriveGeneric, StandaloneDeriving, ScopedTypeVariables,+    GeneralizedNewtypeDeriving, ExistentialQuantification, RecordWildCards,+    CPP #-} {-# OPTIONS_GHC -fno-warn-name-shadowing -fno-warn-orphans #-} +-- |+-- Remote GHCi message types and serialization.+--+-- For details on Remote GHCi, see Note [Remote GHCi] in+-- compiler/ghci/GHCi.hs.+-- module GHCi.Message   ( Message(..), Msg(..)+  , THMessage(..), THMsg(..)+  , QResult(..)   , EvalStatus_(..), EvalStatus, EvalResult(..), EvalOpts(..), EvalExpr(..)   , SerializableException(..)+  , toSerializableException, fromSerializableException   , THResult(..), THResultType(..)   , ResumeContext(..)   , QState(..)-  , getMessage, putMessage-  , Pipe(..), remoteCall, readPipe, writePipe+  , getMessage, putMessage, getTHMessage, putTHMessage+  , Pipe(..), remoteCall, remoteTHCall, readPipe, writePipe   ) where  import GHCi.RemoteTypes@@ -20,6 +30,8 @@ import GHCi.BreakArray  import GHC.LanguageExtensions+import GHC.ForeignSrcLang+import GHC.Fingerprint import Control.Concurrent import Control.Exception import Data.Binary@@ -29,10 +41,18 @@ import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as LB import Data.Dynamic+#if MIN_VERSION_base(4,10,0)+-- Previously this was re-exported by Data.Dynamic+import Data.Typeable (TypeRep)+#endif import Data.IORef import Data.Map (Map) import GHC.Generics+#if MIN_VERSION_base(4,9,0) import GHC.Stack.CCS+#else+import GHC.Stack as GHC.Stack.CCS+#endif import qualified Language.Haskell.TH        as TH import qualified Language.Haskell.TH.Syntax as TH import System.Exit@@ -42,7 +62,8 @@ -- ----------------------------------------------------------------------------- -- The RPC protocol between GHC and the interactive server --- | A @Message a@ is a message that returns a value of type @a@+-- | A @Message a@ is a message that returns a value of type @a@.+-- These are requests sent from GHC to the server. data Message a where   -- | Exit the iserv process   Shutdown :: Message ()@@ -65,11 +86,17 @@   -- Interpreter -------------------------------------------    -- | Create a set of BCO objects, and return HValueRefs to them+  -- Note: Each ByteString contains a Binary-encoded [ResolvedBCO], not+  -- a ResolvedBCO. The list is to allow us to serialise the ResolvedBCOs+  -- in parallel. See @createBCOs@ in compiler/ghci/GHCi.hsc.   CreateBCOs :: [LB.ByteString] -> Message [HValueRef]    -- | Release 'HValueRef's   FreeHValueRefs :: [HValueRef] -> Message () +  -- | Add entries to the Static Pointer Table+  AddSptEntry :: Fingerprint -> HValueRef -> Message ()+   -- | Malloc some data and return a 'RemotePtr' to it   MallocData :: ByteString -> Message (RemotePtr ())   MallocStrings :: [ByteString] -> Message [RemotePtr ()]@@ -158,6 +185,8 @@    -> Message (Maybe HValueRef)    -- Template Haskell -------------------------------------------+  -- For more details on how TH works with Remote GHCi, see+  -- Note [Remote Template Haskell] in libraries/ghci/GHCi/TH.hs.    -- | Start a new TH module, return a state token that should be   StartTH :: Message (RemoteRef (IORef QState))@@ -174,45 +203,110 @@    -> HValueRef {- e.g. TH.Q TH.Exp -}    -> THResultType    -> Maybe TH.Loc-   -> Message ByteString {- e.g. TH.Exp -}--  -- Template Haskell Quasi monad operations-  NewName :: String -> Message (THResult TH.Name)-  Report :: Bool -> String -> Message (THResult ())-  LookupName :: Bool -> String -> Message (THResult (Maybe TH.Name))-  Reify :: TH.Name -> Message (THResult TH.Info)-  ReifyFixity :: TH.Name -> Message (THResult (Maybe TH.Fixity))-  ReifyInstances :: TH.Name -> [TH.Type] -> Message (THResult [TH.Dec])-  ReifyRoles :: TH.Name -> Message (THResult [TH.Role])-  ReifyAnnotations :: TH.AnnLookup -> TypeRep -> Message (THResult [ByteString])-  ReifyModule :: TH.Module -> Message (THResult TH.ModuleInfo)-  ReifyConStrictness :: TH.Name -> Message (THResult [TH.DecidedStrictness])+   -> Message (QResult ByteString)    -- | Run the given mod finalizers.   RunModFinalizers :: RemoteRef (IORef QState)                    -> [RemoteRef (TH.Q ())]-                   -> Message (THResult ())+                   -> Message (QResult ()) -  AddDependentFile :: FilePath -> Message (THResult ())-  AddModFinalizer :: RemoteRef (TH.Q ()) -> Message (THResult ())-  AddTopDecls :: [TH.Dec] -> Message (THResult ())-  IsExtEnabled :: Extension -> Message (THResult Bool)-  ExtsEnabled :: Message (THResult [Extension])+deriving instance Show (Message a) -  StartRecover :: Message ()-  EndRecover :: Bool -> Message () -  -- Template Haskell return values+-- | Template Haskell return values+data QResult a+  = QDone a+    -- ^ RunTH finished successfully; return value follows+  | QException String+    -- ^ RunTH threw an exception+  | QFail String+    -- ^ RunTH called 'fail'+  deriving (Generic, Show) -  -- | RunTH finished successfully; return value follows-  QDone :: Message ()-  -- | RunTH threw an exception-  QException :: String -> Message ()-  -- | RunTH called 'fail'-  QFail :: String -> Message ()+instance Binary a => Binary (QResult a) -deriving instance Show (Message a) +-- | Messages sent back to GHC from GHCi.TH, to implement the methods+-- of 'Quasi'.  For an overview of how TH works with Remote GHCi, see+-- Note [Remote Template Haskell] in GHCi.TH.+data THMessage a where+  NewName :: String -> THMessage (THResult TH.Name)+  Report :: Bool -> String -> THMessage (THResult ())+  LookupName :: Bool -> String -> THMessage (THResult (Maybe TH.Name))+  Reify :: TH.Name -> THMessage (THResult TH.Info)+  ReifyFixity :: TH.Name -> THMessage (THResult (Maybe TH.Fixity))+  ReifyInstances :: TH.Name -> [TH.Type] -> THMessage (THResult [TH.Dec])+  ReifyRoles :: TH.Name -> THMessage (THResult [TH.Role])+  ReifyAnnotations :: TH.AnnLookup -> TypeRep+    -> THMessage (THResult [ByteString])+  ReifyModule :: TH.Module -> THMessage (THResult TH.ModuleInfo)+  ReifyConStrictness :: TH.Name -> THMessage (THResult [TH.DecidedStrictness])++  AddDependentFile :: FilePath -> THMessage (THResult ())+  AddModFinalizer :: RemoteRef (TH.Q ()) -> THMessage (THResult ())+  AddTopDecls :: [TH.Dec] -> THMessage (THResult ())+  AddForeignFile :: ForeignSrcLang -> String -> THMessage (THResult ())+  IsExtEnabled :: Extension -> THMessage (THResult Bool)+  ExtsEnabled :: THMessage (THResult [Extension])++  StartRecover :: THMessage ()+  EndRecover :: Bool -> THMessage ()++  -- | Indicates that this RunTH is finished, and the next message+  -- will be the result of RunTH (a QResult).+  RunTHDone :: THMessage ()++deriving instance Show (THMessage a)++data THMsg = forall a . (Binary a, Show a) => THMsg (THMessage a)++getTHMessage :: Get THMsg+getTHMessage = do+  b <- getWord8+  case b of+    0  -> THMsg <$> NewName <$> get+    1  -> THMsg <$> (Report <$> get <*> get)+    2  -> THMsg <$> (LookupName <$> get <*> get)+    3  -> THMsg <$> Reify <$> get+    4  -> THMsg <$> ReifyFixity <$> get+    5  -> THMsg <$> (ReifyInstances <$> get <*> get)+    6  -> THMsg <$> ReifyRoles <$> get+    7  -> THMsg <$> (ReifyAnnotations <$> get <*> get)+    8  -> THMsg <$> ReifyModule <$> get+    9  -> THMsg <$> ReifyConStrictness <$> get+    10 -> THMsg <$> AddDependentFile <$> get+    11 -> THMsg <$> AddTopDecls <$> get+    12 -> THMsg <$> (IsExtEnabled <$> get)+    13 -> THMsg <$> return ExtsEnabled+    14 -> THMsg <$> return StartRecover+    15 -> THMsg <$> EndRecover <$> get+    16 -> return (THMsg RunTHDone)+    17 -> THMsg <$> AddModFinalizer <$> get+    _  -> THMsg <$> (AddForeignFile <$> get <*> get)++putTHMessage :: THMessage a -> Put+putTHMessage m = case m of+  NewName a                   -> putWord8 0  >> put a+  Report a b                  -> putWord8 1  >> put a >> put b+  LookupName a b              -> putWord8 2  >> put a >> put b+  Reify a                     -> putWord8 3  >> put a+  ReifyFixity a               -> putWord8 4  >> put a+  ReifyInstances a b          -> putWord8 5  >> put a >> put b+  ReifyRoles a                -> putWord8 6  >> put a+  ReifyAnnotations a b        -> putWord8 7  >> put a >> put b+  ReifyModule a               -> putWord8 8  >> put a+  ReifyConStrictness a        -> putWord8 9  >> put a+  AddDependentFile a          -> putWord8 10 >> put a+  AddTopDecls a               -> putWord8 11 >> put a+  IsExtEnabled a              -> putWord8 12 >> put a+  ExtsEnabled                 -> putWord8 13+  StartRecover                -> putWord8 14+  EndRecover a                -> putWord8 15 >> put a+  RunTHDone                   -> putWord8 16+  AddModFinalizer a           -> putWord8 17 >> put a+  AddForeignFile lang a       -> putWord8 18 >> put lang >> put a++ data EvalOpts = EvalOpts   { useSandboxThread :: Bool   , singleStep :: Bool@@ -279,7 +373,28 @@   | EOtherException String   deriving (Generic, Show) -instance Binary ExitCode+toSerializableException :: SomeException -> SerializableException+toSerializableException ex+  | Just UserInterrupt <- fromException ex  = EUserInterrupt+  | Just (ec::ExitCode) <- fromException ex = (EExitCode ec)+  | otherwise = EOtherException (show (ex :: SomeException))++fromSerializableException :: SerializableException -> SomeException+fromSerializableException EUserInterrupt = toException UserInterrupt+fromSerializableException (EExitCode c) = toException c+fromSerializableException (EOtherException str) = toException (ErrorCall str)++-- NB: Replace this with a derived instance once we depend on GHC 8.0+-- as the minimum+instance Binary ExitCode where+  put ExitSuccess      = putWord8 0+  put (ExitFailure ec) = putWord8 1 >> put ec+  get = do+    w <- getWord8+    case w of+      0 -> pure ExitSuccess+      _ -> ExitFailure <$> get+ instance Binary SerializableException  data THResult a@@ -294,6 +409,9 @@  instance Binary THResultType +-- | The server-side Template Haskell state.  This is created by the+-- StartTH message.  A new one is created per module that GHC+-- typechecks. data QState = QState   { qsMap        :: Map TypeRep Dynamic        -- ^ persistent data between splices in a module@@ -342,29 +460,9 @@       29 -> Msg <$> (BreakpointStatus <$> get <*> get)       30 -> Msg <$> (GetBreakpointVar <$> get <*> get)       31 -> Msg <$> return StartTH-      -- 32 is missing-      33 -> Msg <$> (RunTH <$> get <*> get <*> get <*> get)-      34 -> Msg <$> NewName <$> get-      35 -> Msg <$> (Report <$> get <*> get)-      36 -> Msg <$> (LookupName <$> get <*> get)-      37 -> Msg <$> Reify <$> get-      38 -> Msg <$> ReifyFixity <$> get-      39 -> Msg <$> (ReifyInstances <$> get <*> get)-      40 -> Msg <$> ReifyRoles <$> get-      41 -> Msg <$> (ReifyAnnotations <$> get <*> get)-      42 -> Msg <$> ReifyModule <$> get-      43 -> Msg <$> ReifyConStrictness <$> get-      44 -> Msg <$> AddDependentFile <$> get-      45 -> Msg <$> AddTopDecls <$> get-      46 -> Msg <$> (IsExtEnabled <$> get)-      47 -> Msg <$> return ExtsEnabled-      48 -> Msg <$> return StartRecover-      49 -> Msg <$> EndRecover <$> get-      50 -> Msg <$> return QDone-      51 -> Msg <$> QException <$> get-      52 -> Msg <$> (RunModFinalizers <$> get <*> get)-      53 -> Msg <$> (AddModFinalizer <$> get)-      _  -> Msg <$> QFail <$> get+      32 -> Msg <$> (RunModFinalizers <$> get <*> get)+      33 -> Msg <$> (AddSptEntry <$> get <*> get)+      _  -> Msg <$> (RunTH <$> get <*> get <*> get <*> get)  putMessage :: Message a -> Put putMessage m = case m of@@ -400,28 +498,9 @@   BreakpointStatus arr ix     -> putWord8 29 >> put arr >> put ix   GetBreakpointVar a b        -> putWord8 30 >> put a >> put b   StartTH                     -> putWord8 31-  RunTH st q loc ty           -> putWord8 33 >> put st >> put q >> put loc >> put ty-  NewName a                   -> putWord8 34 >> put a-  Report a b                  -> putWord8 35 >> put a >> put b-  LookupName a b              -> putWord8 36 >> put a >> put b-  Reify a                     -> putWord8 37 >> put a-  ReifyFixity a               -> putWord8 38 >> put a-  ReifyInstances a b          -> putWord8 39 >> put a >> put b-  ReifyRoles a                -> putWord8 40 >> put a-  ReifyAnnotations a b        -> putWord8 41 >> put a >> put b-  ReifyModule a               -> putWord8 42 >> put a-  ReifyConStrictness a        -> putWord8 43 >> put a-  AddDependentFile a          -> putWord8 44 >> put a-  AddTopDecls a               -> putWord8 45 >> put a-  IsExtEnabled a              -> putWord8 46 >> put a-  ExtsEnabled                 -> putWord8 47-  StartRecover                -> putWord8 48-  EndRecover a                -> putWord8 49 >> put a-  QDone                       -> putWord8 50-  QException a                -> putWord8 51 >> put a-  RunModFinalizers a b        -> putWord8 52 >> put a >> put b-  AddModFinalizer a           -> putWord8 53 >> put a-  QFail a                     -> putWord8 54 >> put a+  RunModFinalizers a b        -> putWord8 32 >> put a >> put b+  AddSptEntry a b             -> putWord8 33 >> put a >> put b+  RunTH st q loc ty           -> putWord8 34 >> put st >> put q >> put loc >> put ty  -- ----------------------------------------------------------------------------- -- Reading/writing messages@@ -435,6 +514,11 @@ remoteCall :: Binary a => Pipe -> Message a -> IO a remoteCall pipe msg = do   writePipe pipe (putMessage msg)+  readPipe pipe get++remoteTHCall :: Binary a => Pipe -> THMessage a -> IO a+remoteTHCall pipe msg = do+  writePipe pipe (putTHMessage msg)   readPipe pipe get  writePipe :: Pipe -> Put -> IO ()

@@ -11,11 +11,12 @@ -- | Primarily, this module consists of an interface to the C-land -- dynamic linker. module GHCi.ObjLink-  ( initObjLinker+  ( initObjLinker, ShouldRetainCAFs(..)   , loadDLL   , loadArchive   , loadObj   , unloadObj+  , purgeObj   , lookupSymbol   , lookupClosure   , resolveObjs@@ -25,6 +26,7 @@   )  where  import GHCi.RemoteTypes+import Control.Exception (throwIO, ErrorCall(..)) import Control.Monad    ( when ) import Foreign.C import Foreign.Marshal.Alloc ( free )@@ -33,10 +35,31 @@ import System.Posix.Internals ( CFilePath, withFilePath, peekFilePath ) import System.FilePath  ( dropExtension, normalise ) +++ -- --------------------------------------------------------------------------- -- RTS Linker Interface -- --------------------------------------------------------------------------- +data ShouldRetainCAFs+  = RetainCAFs+    -- ^ Retain CAFs unconditionally in linked Haskell code.+    -- Note that this prevents any code from being unloaded.+    -- It should not be necessary unless you are GHCi or+    -- hs-plugins, which needs to be able call any function+    -- in the compiled code.+  | DontRetainCAFs+    -- ^ Do not retain CAFs.  Everything reachable from foreign+    -- exports will be retained, due to the StablePtrs+    -- created by the module initialisation code.  unloadObj+    -- frees these StablePtrs, which will allow the CAFs to+    -- be GC'd and the code to be removed.++initObjLinker :: ShouldRetainCAFs -> IO ()+initObjLinker RetainCAFs = c_initLinker_ 1+initObjLinker _ = c_initLinker_ 0+ lookupSymbol :: String -> IO (Maybe (Ptr a)) lookupSymbol str_in = do    let str = prefixUnderscore str_in@@ -88,20 +111,32 @@ loadArchive str = do    withFilePath str $ \c_str -> do      r <- c_loadArchive c_str-     when (r == 0) (error ("loadArchive " ++ show str ++ ": failed"))+     when (r == 0) (throwIO (ErrorCall ("loadArchive " ++ show str ++ ": failed")))  loadObj :: String -> IO () loadObj str = do    withFilePath str $ \c_str -> do      r <- c_loadObj c_str-     when (r == 0) (error ("loadObj " ++ show str ++ ": failed"))+     when (r == 0) (throwIO (ErrorCall ("loadObj " ++ show str ++ ": failed"))) +-- | @unloadObj@ drops the given dynamic library from the symbol table+-- as well as enables the library to be removed from memory during+-- a future major GC. unloadObj :: String -> IO () unloadObj str =    withFilePath str $ \c_str -> do      r <- c_unloadObj c_str-     when (r == 0) (error ("unloadObj " ++ show str ++ ": failed"))+     when (r == 0) (throwIO (ErrorCall ("unloadObj " ++ show str ++ ": failed"))) +-- | @purgeObj@ drops the symbols for the dynamic library from the symbol+-- table. Unlike 'unloadObj', the library will not be dropped memory during+-- a future major GC.+purgeObj :: String -> IO ()+purgeObj str =+   withFilePath str $ \c_str -> do+     r <- c_purgeObj c_str+     when (r == 0) (throwIO (ErrorCall ("purgeObj " ++ show str ++ ": failed")))+ addLibrarySearchPath :: String -> IO (Ptr ()) addLibrarySearchPath str =    withFilePath str c_addLibrarySearchPath@@ -128,10 +163,11 @@ -- ---------------------------------------------------------------------------  foreign import ccall unsafe "addDLL"                  c_addDLL                  :: CFilePath -> IO CString-foreign import ccall unsafe "initLinker"              initObjLinker             :: IO ()+foreign import ccall unsafe "initLinker_"             c_initLinker_             :: CInt -> IO () foreign import ccall unsafe "lookupSymbol"            c_lookupSymbol            :: CString -> IO (Ptr a) foreign import ccall unsafe "loadArchive"             c_loadArchive             :: CFilePath -> IO Int foreign import ccall unsafe "loadObj"                 c_loadObj                 :: CFilePath -> IO Int+foreign import ccall unsafe "purgeObj"                c_purgeObj                :: CFilePath -> IO Int foreign import ccall unsafe "unloadObj"               c_unloadObj               :: CFilePath -> IO Int foreign import ccall unsafe "resolveObjs"             c_resolveObjs             :: IO Int foreign import ccall unsafe "addLibrarySearchPath"    c_addLibrarySearchPath    :: CFilePath -> IO (Ptr ())

@@ -1,4 +1,12 @@ {-# LANGUAGE CPP, StandaloneDeriving, GeneralizedNewtypeDeriving #-}++-- |+-- Types for referring to remote objects in Remote GHCi.  For more+-- details, see Note [External GHCi pointers] in compiler/ghci/GHCi.hs+--+-- For details on Remote GHCi, see Note [Remote GHCi] in+-- compiler/ghci/GHCi.hs.+-- module GHCi.RemoteTypes   ( RemotePtr(..), toRemotePtr, fromRemotePtr, castRemotePtr   , HValue(..)

@@ -3,11 +3,13 @@ {-# OPTIONS_GHC -fno-warn-name-shadowing #-}  -- |--- Execute GHCi messages+-- Execute GHCi messages. --+-- For details on Remote GHCi, see Note [Remote GHCi] in+-- compiler/ghci/GHCi.hs.+-- module GHCi.Run   ( run, redirectInterrupts-  , toSerializableException, fromSerializableException   ) where  import GHCi.CreateBCO@@ -18,6 +20,7 @@ import GHCi.RemoteTypes import GHCi.TH import GHCi.BreakArray+import GHCi.StaticPtrTable  import Control.Concurrent import Control.DeepSeq@@ -33,7 +36,6 @@ import Foreign.C import GHC.Conc.Sync import GHC.IO hiding ( bracket )-import System.Exit import System.Mem.Weak  ( deRefWeak ) import Unsafe.Coerce @@ -42,7 +44,7 @@  run :: Message a -> IO a run m = case m of-  InitLinker -> initObjLinker+  InitLinker -> initObjLinker RetainCAFs   LookupSymbol str -> fmap toRemotePtr <$> lookupSymbol str   LookupClosure str -> lookupClosure str   LoadDLL str -> loadDLL str@@ -55,6 +57,7 @@   FindSystemLibrary str -> findSystemLibrary str   CreateBCOs bcos -> createBCOs (concatMap (runGet get) bcos)   FreeHValueRefs rs -> mapM_ freeRemoteRef rs+  AddSptEntry fpr r -> localRef r >>= sptAddEntry fpr   EvalStmt opts r -> evalStmt opts r   ResumeStmt opts r -> resumeStmt opts r   AbandonStmt r -> abandonStmt r@@ -219,17 +222,6 @@   case e of     Left ex -> return (EvalException (toSerializableException ex))     Right a -> return (EvalSuccess a)--toSerializableException :: SomeException -> SerializableException-toSerializableException ex-  | Just UserInterrupt <- fromException ex  = EUserInterrupt-  | Just (ec::ExitCode) <- fromException ex = (EExitCode ec)-  | otherwise = EOtherException (show (ex :: SomeException))--fromSerializableException :: SerializableException -> SomeException-fromSerializableException EUserInterrupt = toException UserInterrupt-fromSerializableException (EExitCode c) = toException c-fromSerializableException (EOtherException str) = toException (ErrorCall str)  -- This function sets up the interpreter for catching breakpoints, and -- resets everything when the computation has stopped running.  This

@@ -0,0 +1,24 @@+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE ForeignFunctionInterface #-}++module GHCi.StaticPtrTable ( sptAddEntry ) where++import Data.Word+import Foreign+import GHC.Fingerprint+import GHCi.RemoteTypes++-- | Used by GHCi to add an SPT entry for a set of interactive bindings.+sptAddEntry :: Fingerprint -> HValue -> IO ()+sptAddEntry (Fingerprint a b) (HValue x) = do+    -- We own the memory holding the key (fingerprint) which gets inserted into+    -- the static pointer table and can't free it until the SPT entry is removed+    -- (which is currently never).+    fpr_ptr <- newArray [a,b]+    sptr <- newStablePtr x+    ent_ptr <- malloc+    poke ent_ptr (castStablePtrToPtr sptr)+    spt_insert_stableptr fpr_ptr ent_ptr++foreign import ccall "hs_spt_insert_stableptr"+    spt_insert_stableptr :: Ptr Word64 -> Ptr (Ptr ()) -> IO ()

@@ -12,6 +12,85 @@   , GHCiQException(..)   ) where +{- Note [Remote Template Haskell]++Here is an overview of how TH works with -fexternal-interpreter.++Initialisation+~~~~~~~~~~~~~~++GHC sends a StartTH message to the server (see TcSplice.getTHState):++   StartTH :: Message (RemoteRef (IORef QState))++The server creates an initial QState object, makes an IORef to it, and+returns a RemoteRef to this to GHC. (see GHCi.TH.startTH below).++This happens once per module, the first time we need to run a TH+splice.  The reference that GHC gets back is kept in+tcg_th_remote_state in the TcGblEnv, and passed to each RunTH call+that follows.+++For each splice+~~~~~~~~~~~~~~~++1. GHC compiles a splice to byte code, and sends it to the server: in+   a CreateBCOs message:++   CreateBCOs :: [LB.ByteString] -> Message [HValueRef]++2. The server creates the real byte-code objects in its heap, and+   returns HValueRefs to GHC.  HValueRef is the same as RemoteRef+   HValue.++3. GHC sends a RunTH message to the server:++  RunTH+   :: RemoteRef (IORef QState)+        -- The state returned by StartTH in step1+   -> HValueRef+        -- The HValueRef we got in step 4, points to the code for the splice+   -> THResultType+        -- Tells us what kind of splice this is (decl, expr, type, etc.)+   -> Maybe TH.Loc+        -- Source location+   -> Message (QResult ByteString)+        -- Eventually it will return a QResult back to GHC.  The+        -- ByteString here is the (encoded) result of the splice.++4. The server runs the splice code.++5. Each time the splice code calls a method of the Quasi class, such+   as qReify, a message is sent from the server to GHC.  These+   messages are defined by the THMessage type.  GHC responds with the+   result of the request, e.g. in the case of qReify it would be the+   TH.Info for the requested entity.++6. When the splice has been fully evaluated, the server sends+   RunTHDone back to GHC.  This tells GHC that the server has finished+   sending THMessages and will send the QResult next.++8. The server then sends a QResult back to GHC, which is notionally+   the response to the original RunTH message.  The QResult indicates+   whether the splice succeeded, failed, or threw an exception.+++After typechecking+~~~~~~~~~~~~~~~~~~++GHC sends a FinishTH message to the server (see TcSplice.finishTH).+The server runs any finalizers that were added by addModuleFinalizer.+++Other Notes on TH / Remote GHCi++  * Note [Remote GHCi] in compiler/ghci/GHCi.hs+  * Note [External GHCi pointers] in compiler/ghci/GHCi.hs+  * Note [TH recover with -fexternal-interpreter] in+    compiler/typecheck/TcSplice.hs+-}+ import GHCi.Message import GHCi.RemoteTypes import GHC.Serialized@@ -34,13 +113,16 @@ import qualified Language.Haskell.TH.Syntax as TH import Unsafe.Coerce +-- | Create a new instance of 'QState' initQState :: Pipe -> QState initQState p = QState M.empty Nothing p +-- | The monad in which we run TH computations on the server newtype GHCiQ a = GHCiQ { runGHCiQ :: QState -> IO (a, QState) } +-- | The exception thrown by "fail" in the GHCiQ monad data GHCiQException = GHCiQException QState String-  deriving (Show, Typeable)+  deriving Show  instance Exception GHCiQException @@ -59,7 +141,6 @@     do (m', s')  <- runGHCiQ m s        (a,  s'') <- runGHCiQ (f m') s'        return (a, s'')-   fail = Fail.fail  instance Fail.MonadFail GHCiQ where@@ -71,9 +152,10 @@ noLoc :: TH.Loc noLoc = TH.Loc "<no file>" "<no package>" "<no module>" (0,0) (0,0) -ghcCmd :: Binary a => Message (THResult a) -> GHCiQ a+-- | Send a 'THMessage' to GHC and return the result.+ghcCmd :: Binary a => THMessage (THResult a) -> GHCiQ a ghcCmd m = GHCiQ $ \s -> do-  r <- remoteCall (qsPipe s) m+  r <- remoteTHCall (qsPipe s) m   case r of     THException str -> throwIO (GHCiQException s str)     THComplete res -> return (res, s)@@ -84,12 +166,12 @@    -- See Note [TH recover with -fexternal-interpreter] in TcSplice   qRecover (GHCiQ h) (GHCiQ a) = GHCiQ $ \s -> (do-    remoteCall (qsPipe s) StartRecover+    remoteTHCall (qsPipe s) StartRecover     (r, s') <- a s-    remoteCall (qsPipe s) (EndRecover False)+    remoteTHCall (qsPipe s) (EndRecover False)     return (r,s'))       `catch`-       \GHCiQException{} -> remoteCall (qsPipe s) (EndRecover True) >> h s+       \GHCiQException{} -> remoteTHCall (qsPipe s) (EndRecover True) >> h s   qLookupName isType occ = ghcCmd (LookupName isType occ)   qReify name = ghcCmd (Reify name)   qReifyFixity name = ghcCmd (ReifyFixity name)@@ -111,6 +193,7 @@   qRunIO m = GHCiQ $ \s -> fmap (,s) m   qAddDependentFile file = ghcCmd (AddDependentFile file)   qAddTopDecls decls = ghcCmd (AddTopDecls decls)+  qAddForeignFile str lang = ghcCmd (AddForeignFile str lang)   qAddModFinalizer fin = GHCiQ (\s -> mkRemoteRef fin >>= return . (, s)) >>=                          ghcCmd . AddModFinalizer   qGetQ = GHCiQ $ \s ->@@ -122,6 +205,8 @@   qIsExtEnabled x = ghcCmd (IsExtEnabled x)   qExtsEnabled = ghcCmd ExtsEnabled +-- | The implementation of the 'StartTH' message: create+-- a new IORef QState, and return a RemoteRef to it. startTH :: IO (RemoteRef (IORef QState)) startTH = do   r <- newIORef (initQState (error "startTH: no pipe"))@@ -140,11 +225,20 @@   _ <- runGHCiQ (TH.runQ $ sequence_ qs) qstate { qsPipe = pipe }   return () +-- | The implementation of the 'RunTH' message runTH-  :: Pipe -> RemoteRef (IORef QState) -> HValueRef+  :: Pipe+  -> RemoteRef (IORef QState)+      -- ^ The TH state, created by 'startTH'+  -> HValueRef+      -- ^ The splice to run   -> THResultType+      -- ^ What kind of splice it is   -> Maybe TH.Loc+      -- ^ The source location   -> IO ByteString+      -- ^ Returns an (encoded) result that depends on the THResultType+ runTH pipe rstate rhv ty mb_loc = do   hv <- localRef rhv   case ty of@@ -158,6 +252,7 @@         AnnotationWrapper thing -> return $!           LB.toStrict (runPut (put (toSerialized serializeWithData thing))) +-- | Run a Q computation. runTHQ   :: Binary a => Pipe -> RemoteRef (IORef QState) -> Maybe TH.Loc -> TH.Q a   -> IO ByteString

@@ -1,14 +1,21 @@ {-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE GADTs #-}+ -- This module is full of orphans, unfortunately module GHCi.TH.Binary () where  import Data.Binary import qualified Data.ByteString as B-import Data.Typeable import GHC.Serialized import qualified Language.Haskell.TH        as TH import qualified Language.Haskell.TH.Syntax as TH-+#if !MIN_VERSION_base(4,10,0)+import Data.Typeable+#endif -- Put these in a separate module because they take ages to compile  instance Binary TH.Loc@@ -30,6 +37,8 @@ instance Binary TH.Exp instance Binary TH.Dec instance Binary TH.Overlap+instance Binary TH.DerivClause+instance Binary TH.DerivStrategy instance Binary TH.Guard instance Binary TH.Body instance Binary TH.Match@@ -59,9 +68,17 @@ instance Binary TH.InjectivityAnn instance Binary TH.FamilyResultSig instance Binary TH.TypeFamilyHead+instance Binary TH.PatSynDir+instance Binary TH.PatSynArgs  -- We need Binary TypeRep for serializing annotations +instance Binary Serialized where+    put (Serialized tyrep wds) = put tyrep >> put (B.pack wds)+    get = Serialized <$> get <*> (B.unpack <$> get)++-- Typeable and related instances live in binary since GHC 8.2+#if !MIN_VERSION_base(4,10,0) instance Binary TyCon where     put tc = put (tyConPackage tc) >> put (tyConModule tc) >> put (tyConName tc)     get = mkTyCon3 <$> get <*> get <*> get@@ -71,7 +88,4 @@     get = do         (ty_con, child_type_reps) <- get         return (mkTyConApp ty_con child_type_reps)--instance Binary Serialized where-    put (Serialized tyrep wds) = put tyrep >> put (B.pack wds)-    get = Serialized <$> get <*> (B.unpack <$> get)+#endif

@@ -1,8 +1,18 @@+## 8.2.1  *Jul 2017*++  * Bundled with GHC 8.2.1++  * Add support for StaticPointers in GHCi (#12356)++  * Move Typeable Binary instances to binary package+ ## 8.0.2  *Jan 2017*    * Bundled with GHC 8.0.2    * Tag pointers in interpreted constructors (#12523)++  * Add `NFData` instances  ## 8.0.1  *Feb 2016* 

@@ -1,8 +1,5 @@--- WARNING: ghci.cabal is automatically generated from ghci.cabal.in by--- ../../configure.  Make sure you are editing ghci.cabal.in, not ghci.cabal.- name:           ghci-version:        8.0.2+version:        8.2.1 license:        BSD3 license-file:   LICENSE category:       GHC@@ -17,6 +14,11 @@ build-type:     Simple extra-source-files: changelog.md +Flag ghci+    Description: Build GHCi support.+    Default: False+    Manual: True+ source-repository head     type:     git     location: http://git.haskell.org/ghc.git@@ -41,31 +43,37 @@         TupleSections         UnboxedTuples +    if flag(ghci)+        CPP-Options: -DGHCI+        exposed-modules:+            GHCi.Run+            GHCi.CreateBCO+            GHCi.ObjLink+            GHCi.Signals+            GHCi.TH+     exposed-modules:         GHCi.BreakArray         GHCi.Message         GHCi.ResolvedBCO         GHCi.RemoteTypes-        GHCi.ObjLink-        GHCi.CreateBCO         GHCi.FFI         GHCi.InfoTable-        GHCi.Run-        GHCi.Signals-        GHCi.TH+        GHCi.StaticPtrTable         GHCi.TH.Binary         SizedSeq      Build-Depends:         array            == 0.5.*,-        base             == 4.9.*,+        base             >= 4.8 && < 4.11,         binary           == 0.8.*,         bytestring       == 0.10.*,         containers       == 0.5.*,         deepseq          == 1.4.*,         filepath         == 1.4.*,-        ghc-boot         == 8.0.2,-        template-haskell == 2.11.*,+        ghc-boot         == 8.2.1,+        ghc-boot-th      == 8.2.1,+        template-haskell == 2.12.*,         transformers     == 0.5.*      if !os(windows)