ghci 8.0.1 → 8.0.2

raw patch · 8 files changed

+73/−36 lines, 8 filesdep ~ghc-bootPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: ghc-boot

API changes (from Hackage documentation)

Files

• GHCi/InfoTable.hsc +20/−4
• GHCi/Message.hs +15/−10
• GHCi/RemoteTypes.hs +5/−0
• GHCi/Run.hs +2/−2
• GHCi/TH.hs +18/−17
• SizedSeq.hs +5/−1
• changelog.md +6/−0
• ghci.cabal +2/−2

@@ -24,15 +24,16 @@    :: Int     -- ptr words    -> Int     -- non-ptr words    -> Int     -- constr tag+   -> Int     -- pointer tag    -> [Word8]  -- con desc    -> IO (Ptr StgInfoTable)       -- resulting info table is allocated with allocateExec(), and       -- should be freed with freeExec(). -mkConInfoTable ptr_words nonptr_words tag con_desc =+mkConInfoTable ptr_words nonptr_words tag ptrtag con_desc =   castFunPtrToPtr <$> newExecConItbl itbl con_desc   where-     entry_addr = stg_interp_constr_entry+     entry_addr = interpConstrEntry !! ptrtag      code' = mkJumpToAddr entry_addr      itbl  = StgInfoTable {                  entry = if ghciTablesNextToCode@@ -283,8 +284,23 @@ #include "Rts.h"  -- entry point for direct returns for created constr itbls-foreign import ccall "&stg_interp_constr_entry"-    stg_interp_constr_entry :: EntryFunPtr+foreign import ccall "&stg_interp_constr1_entry" stg_interp_constr1_entry :: EntryFunPtr+foreign import ccall "&stg_interp_constr2_entry" stg_interp_constr2_entry :: EntryFunPtr+foreign import ccall "&stg_interp_constr3_entry" stg_interp_constr3_entry :: EntryFunPtr+foreign import ccall "&stg_interp_constr4_entry" stg_interp_constr4_entry :: EntryFunPtr+foreign import ccall "&stg_interp_constr5_entry" stg_interp_constr5_entry :: EntryFunPtr+foreign import ccall "&stg_interp_constr6_entry" stg_interp_constr6_entry :: EntryFunPtr+foreign import ccall "&stg_interp_constr7_entry" stg_interp_constr7_entry :: EntryFunPtr++interpConstrEntry :: [EntryFunPtr]+interpConstrEntry = [ error "pointer tag 0"+                    , stg_interp_constr1_entry+                    , stg_interp_constr2_entry+                    , stg_interp_constr3_entry+                    , stg_interp_constr4_entry+                    , stg_interp_constr5_entry+                    , stg_interp_constr6_entry+                    , stg_interp_constr7_entry ]  -- Ultra-minimalist version specially for constructors #if SIZEOF_VOID_P == 8

@@ -85,6 +85,7 @@    :: Int     -- ptr words    -> Int     -- non-ptr words    -> Int     -- constr tag+   -> Int     -- pointer tag    -> [Word8] -- constructor desccription    -> Message (RemotePtr StgInfoTable) @@ -161,9 +162,6 @@   -- | Start a new TH module, return a state token that should be   StartTH :: Message (RemoteRef (IORef QState)) -  -- | Run TH module finalizers, and free the HValueRef-  FinishTH :: RemoteRef (IORef QState) -> Message ()-   -- | Evaluate a TH computation.   --   -- Returns a ByteString, because we have to force the result@@ -190,7 +188,13 @@   ReifyModule :: TH.Module -> Message (THResult TH.ModuleInfo)   ReifyConStrictness :: TH.Name -> Message (THResult [TH.DecidedStrictness]) +  -- | Run the given mod finalizers.+  RunModFinalizers :: RemoteRef (IORef QState)+                   -> [RemoteRef (TH.Q ())]+                   -> Message (THResult ())+   AddDependentFile :: FilePath -> Message (THResult ())+  AddModFinalizer :: RemoteRef (TH.Q ()) -> Message (THResult ())   AddTopDecls :: [TH.Dec] -> Message (THResult ())   IsExtEnabled :: Extension -> Message (THResult Bool)   ExtsEnabled :: Message (THResult [Extension])@@ -293,8 +297,6 @@ data QState = QState   { qsMap        :: Map TypeRep Dynamic        -- ^ persistent data between splices in a module-  , qsFinalizers :: [TH.Q ()]-       -- ^ registered finalizers (in reverse order)   , qsLocation   :: Maybe TH.Loc        -- ^ location for current splice, if any   , qsPipe :: Pipe@@ -326,7 +328,7 @@       15 -> Msg <$> MallocStrings <$> get       16 -> Msg <$> (PrepFFI <$> get <*> get <*> get)       17 -> Msg <$> FreeFFI <$> get-      18 -> Msg <$> (MkConInfoTable <$> get <*> get <*> get <*> get)+      18 -> Msg <$> (MkConInfoTable <$> get <*> get <*> get <*> get <*> get)       19 -> Msg <$> (EvalStmt <$> get <*> get)       20 -> Msg <$> (ResumeStmt <$> get <*> get)       21 -> Msg <$> (AbandonStmt <$> get)@@ -340,7 +342,7 @@       29 -> Msg <$> (BreakpointStatus <$> get <*> get)       30 -> Msg <$> (GetBreakpointVar <$> get <*> get)       31 -> Msg <$> return StartTH-      32 -> Msg <$> FinishTH <$> get+      -- 32 is missing       33 -> Msg <$> (RunTH <$> get <*> get <*> get <*> get)       34 -> Msg <$> NewName <$> get       35 -> Msg <$> (Report <$> get <*> get)@@ -360,6 +362,8 @@       49 -> Msg <$> EndRecover <$> get       50 -> Msg <$> return QDone       51 -> Msg <$> QException <$> get+      52 -> Msg <$> (RunModFinalizers <$> get <*> get)+      53 -> Msg <$> (AddModFinalizer <$> get)       _  -> Msg <$> QFail <$> get  putMessage :: Message a -> Put@@ -382,7 +386,7 @@   MallocStrings bss           -> putWord8 15 >> put bss   PrepFFI conv args res       -> putWord8 16 >> put conv >> put args >> put res   FreeFFI p                   -> putWord8 17 >> put p-  MkConInfoTable p n t d      -> putWord8 18 >> put p >> put n >> put t >> put d+  MkConInfoTable p n t pt d   -> putWord8 18 >> put p >> put n >> put t >> put pt >> put d   EvalStmt opts val           -> putWord8 19 >> put opts >> put val   ResumeStmt opts val         -> putWord8 20 >> put opts >> put val   AbandonStmt val             -> putWord8 21 >> put val@@ -396,7 +400,6 @@   BreakpointStatus arr ix     -> putWord8 29 >> put arr >> put ix   GetBreakpointVar a b        -> putWord8 30 >> put a >> put b   StartTH                     -> putWord8 31-  FinishTH val                -> putWord8 32 >> put val   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@@ -416,7 +419,9 @@   EndRecover a                -> putWord8 49 >> put a   QDone                       -> putWord8 50   QException a                -> putWord8 51 >> put a-  QFail a                     -> putWord8 52  >> put a+  RunModFinalizers a b        -> putWord8 52 >> put a >> put b+  AddModFinalizer a           -> putWord8 53 >> put a+  QFail a                     -> putWord8 54 >> put a  -- ----------------------------------------------------------------------------- -- Reading/writing messages

@@ -9,6 +9,7 @@   , unsafeForeignRefToRemoteRef, finalizeForeignRef   ) where +import Control.DeepSeq import Data.Word import Foreign hiding (newForeignPtr) import Foreign.Concurrent@@ -41,6 +42,7 @@  deriving instance Show (RemotePtr a) deriving instance Binary (RemotePtr a)+deriving instance NFData (RemotePtr a)  -- ----------------------------------------------------------------------------- -- HValueRef@@ -82,6 +84,9 @@  -- | An HValueRef with a finalizer newtype ForeignRef a = ForeignRef (ForeignPtr ())++instance NFData (ForeignRef a) where+  rnf x = x `seq` ()  type ForeignHValue = ForeignRef HValue 

@@ -80,8 +80,8 @@   MallocStrings bss -> mapM mkString0 bss   PrepFFI conv args res -> toRemotePtr <$> prepForeignCall conv args res   FreeFFI p -> freeForeignCallInfo (fromRemotePtr p)-  MkConInfoTable ptrs nptrs tag desc ->-    toRemotePtr <$> mkConInfoTable ptrs nptrs tag desc+  MkConInfoTable ptrs nptrs tag ptrtag desc ->+    toRemotePtr <$> mkConInfoTable ptrs nptrs tag ptrtag desc   StartTH -> startTH   _other -> error "GHCi.Run.run" 

@@ -5,7 +5,12 @@ -- | -- Running TH splices ---module GHCi.TH (startTH, finishTH, runTH, GHCiQException(..)) where+module GHCi.TH+  ( startTH+  , runModFinalizerRefs+  , runTH+  , GHCiQException(..)+  ) where  import GHCi.Message import GHCi.RemoteTypes@@ -30,14 +35,7 @@ import Unsafe.Coerce  initQState :: Pipe -> QState-initQState p = QState M.empty [] Nothing p--runModFinalizers :: GHCiQ ()-runModFinalizers = go =<< getState-  where-    go s | (f:ff) <- qsFinalizers s = do-      putState (s { qsFinalizers = ff}) >> TH.runQ f >> getState >>= go-    go _ = return ()+initQState p = QState M.empty Nothing p  newtype GHCiQ a = GHCiQ { runGHCiQ :: QState -> IO (a, QState) } @@ -70,9 +68,6 @@ getState :: GHCiQ QState getState = GHCiQ $ \s -> return (s,s) -putState :: QState -> GHCiQ ()-putState s = GHCiQ $ \_ -> return ((),s)- noLoc :: TH.Loc noLoc = TH.Loc "<no file>" "<no package>" "<no module>" (0,0) (0,0) @@ -116,8 +111,8 @@   qRunIO m = GHCiQ $ \s -> fmap (,s) m   qAddDependentFile file = ghcCmd (AddDependentFile file)   qAddTopDecls decls = ghcCmd (AddTopDecls decls)-  qAddModFinalizer fin = GHCiQ $ \s ->-    return ((), s { qsFinalizers = fin : qsFinalizers s })+  qAddModFinalizer fin = GHCiQ (\s -> mkRemoteRef fin >>= return . (, s)) >>=+                         ghcCmd . AddModFinalizer   qGetQ = GHCiQ $ \s ->     let lookup :: forall a. Typeable a => Map TypeRep Dynamic -> Maybe a         lookup m = fromDynamic =<< M.lookup (typeOf (undefined::a)) m@@ -132,11 +127,17 @@   r <- newIORef (initQState (error "startTH: no pipe"))   mkRemoteRef r -finishTH :: Pipe -> RemoteRef (IORef QState) -> IO ()-finishTH pipe rstate = do+-- | Runs the mod finalizers.+--+-- The references must be created on the caller process.+runModFinalizerRefs :: Pipe -> RemoteRef (IORef QState)+                    -> [RemoteRef (TH.Q ())]+                    -> IO ()+runModFinalizerRefs pipe rstate qrefs = do+  qs <- mapM localRef qrefs   qstateref <- localRef rstate   qstate <- readIORef qstateref-  _ <- runGHCiQ runModFinalizers qstate { qsPipe = pipe }+  _ <- runGHCiQ (TH.runQ $ sequence_ qs) qstate { qsPipe = pipe }   return ()  runTH

@@ -8,11 +8,12 @@   , sizeSS   ) where +import Control.DeepSeq import Data.Binary import Data.List import GHC.Generics -data SizedSeq a = SizedSeq !Word [a]+data SizedSeq a = SizedSeq {-# UNPACK #-} !Word [a]   deriving (Generic, Show)  instance Functor SizedSeq where@@ -25,6 +26,9 @@   traverse f (SizedSeq sz l) = SizedSeq sz . reverse <$> traverse f (reverse l)  instance Binary a => Binary (SizedSeq a)++instance NFData a => NFData (SizedSeq a) where+  rnf (SizedSeq _ xs) = rnf xs  emptySS :: SizedSeq a emptySS = SizedSeq 0 []

@@ -1,3 +1,9 @@+## 8.0.2  *Jan 2017*++  * Bundled with GHC 8.0.2++  * Tag pointers in interpreted constructors (#12523)+ ## 8.0.1  *Feb 2016*    * Bundled with GHC 8.0.1

@@ -2,7 +2,7 @@ -- ../../configure.  Make sure you are editing ghci.cabal.in, not ghci.cabal.  name:           ghci-version:        8.0.1+version:        8.0.2 license:        BSD3 license-file:   LICENSE category:       GHC@@ -64,7 +64,7 @@         containers       == 0.5.*,         deepseq          == 1.4.*,         filepath         == 1.4.*,-        ghc-boot         == 8.0.1,+        ghc-boot         == 8.0.2,         template-haskell == 2.11.*,         transformers     == 0.5.*