ghc-hotswap (empty) → 0.1.0.0

raw patch · 5 files changed

+260/−0 lines, 5 filesdep +basedep +concurrent-extradep +deepseqsetup-changed

Dependencies added: base, concurrent-extra, deepseq, ghci

Files

• GHC/Hotswap.hs +166/−0
• LICENSE +30/−0
• PATENTS +33/−0
• Setup.hs +2/−0
• ghc-hotswap.cabal +29/−0

@@ -0,0 +1,166 @@+-- Copyright (c) 2017-present, Facebook, Inc.+-- All rights reserved.+--+-- This source code is licensed under the BSD-style license found in the+-- LICENSE file in the root directory of this source tree. An additional grant+-- of patent rights can be found in the PATENTS file in the same directory.++{-# LANGUAGE CPP #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RecordWildCards #-}++{-| A library for safely interacting with frequently updating shared+objects within a haskell binary. See more documentation at <https://github.com/fbsamples/ghc-hotswap/>.++Assuming you have some structure of data called `Foo`.++In common types:+```+type FooExport = IO (StablePtr Foo)+```++In the shared object:+```+foreign export ccall "hs_mySOFunction"+  hsHandle :: FooExport++hsHandle :: FooExport+hsHandle = newStablePtr Foo+  { ...+  }+```++In the main binary:+```+main = do+  myData <- registerHotswap "hs_mySOFunction" "/path/to/lib.o"+  (withSO myData) $ \Foo{..} -> do+    -- first version+    ...++  (swapSO myData) "/path/to/next_lib.o"+  (withSO myData) $ \Foo{..} -> do+    -- next version+    ...+```+-}++module GHC.Hotswap+  ( UpdatableSO+  , swapSO+  , withSO+  , registerHotswap+  ) where++import qualified Control.Concurrent.ReadWriteLock as L+import Control.Concurrent.MVar+import Control.DeepSeq+import Control.Exception+import Control.Monad++import GHCi.ObjLink+import Foreign++-- | Access control for a shared object that return a type `a` from the+-- shared object+data UpdatableSO a = UpdatableSO+  { swapSO :: FilePath -> IO ()+    -- ^ Loads and links the new object such that future calls to `withSO` will+    -- use the new objects. Existing calls in the old object will complete as+    -- normal and the old object will be unloaded when all references to it+    -- are dropped.+    -- The underlying work is not thread safe, so it's on the caller to+    -- appropriately serialize these calls to avoid accidentally skipping an+    -- update.+  , withSO :: forall b . (a -> IO b) -> IO b+    -- ^ Accessor for information out of the shared object. Use this to run+    -- something with data from the latest shared object. You are guaranteed+    -- to access the latest object and the object will be retained until+    -- the call finishes.+    -- Always eventually return from calling this function, otherwise+    -- objects will not be dropped.+  }++-- | Internal state associated with a single instance of a shared object+data SOState a = SOState+  { lock :: L.RWLock -- Protects the data so we know when to safely delete+  , path :: FilePath -- The local path to the object+  , val :: a         -- The extracted value we wanted+  }++-- | Loads a shared object, pulls out the particular symbol name, and returns+-- a control structure for interacting with the data+registerHotswap+  :: NFData a+  => String         -- exported c-name of the (:: IO (StablePtr a)) symbol+  -> FilePath       -- path to the first instance of the shared object+  -> IO (UpdatableSO a)  -- control structure+registerHotswap symbolName firstPath = do+  firstVal <- force <$> loadNewSO symbolName firstPath+  firstLock <- L.new+  sMVar <- newMVar SOState+    { lock = firstLock+    , path = firstPath+    , val = firstVal+    }+  return UpdatableSO+    { swapSO = updateState sMVar symbolName+    , withSO = unWrap sMVar+    }++-- | Safely runs an action on a value from the shared object+unWrap :: MVar (SOState a) -> (a -> IO b) -> IO b+unWrap mvar action = do+  SOState{..} <- readMVar mvar+  L.withRead lock $ action val++-- | Safely updates the state to handle an updated shared object+updateState+  :: NFData a+  => MVar (SOState a)  -- State to edit+  -> String            -- exported c-name of the symbol to lookup+  -> FilePath          -- path to the next instance of the shared object+  -> IO ()+updateState mvar symbolName nextPath = do+  newVal <- force <$> loadNewSO symbolName nextPath+  -- Build a new state for this version+  newLock <- L.new+  let+    newState = SOState+      { lock = newLock+      , path = nextPath+      , val = newVal+      }+  -- Swapping in the new state means all new calls to `withSO` from the client+  -- will use the new value. After this it's impossible for a new read lock to+  -- grab the old state+  oldState <- swapMVar mvar newState+  -- All readers in oldState will fall out, so we're safe to destroy state here+  L.withWrite (lock oldState) $+    unloadObj (path oldState)++-- Extract the function pointer as a callable Haskell function+foreign import ccall "dynamic"+  callExport :: FunPtr (IO (StablePtr a)) -> IO (StablePtr a)++-- | Nuts and bolts for bringing in a new object+loadNewSO :: String -> FilePath -> IO a+loadNewSO symName newSO = do+  -- initObjLinker is idempotent+  initObjLinker DontRetainCAFs++  loadObj newSO+  resolved <- resolveObjs+  unless resolved $ do+    unloadObj newSO+    throwIO (ErrorCall $ "Unable to resolve objects for " ++ newSO)+  c_sym <- lookupSymbol symName+  h <- case c_sym of+    Nothing -> do+      unloadObj newSO+      throwIO (ErrorCall "Could not find symbol")+    Just p_sym ->+      bracket (callExport $ castPtrToFunPtr p_sym) freeStablePtr deRefStablePtr+  -- Dump the symbol table to make room for when the next object comes in+  purgeObj newSO+  return h

@@ -0,0 +1,30 @@+BSD License++For ghc-hotswap software++Copyright (c) 2017-present, Facebook, Inc. All rights reserved.++Redistribution and use in source and binary forms, with or without modification,+are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright notice, this+   list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above copyright notice,+   this list of conditions and the following disclaimer in the documentation+   and/or other materials provided with the distribution.++ * Neither the name Facebook nor the names of its contributors may be used to+   endorse or promote products derived from this software without specific+   prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON+ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,33 @@+Additional Grant of Patent Rights Version 2++"Software" means the ghc-hotswap software contributed by Facebook, Inc.++Facebook, Inc. ("Facebook") hereby grants to each recipient of the Software+("you") a perpetual, worldwide, royalty-free, non-exclusive, irrevocable+(subject to the termination provision below) license under any Necessary+Claims, to make, have made, use, sell, offer to sell, import, and otherwise+transfer the Software. For avoidance of doubt, no license is granted under+Facebook’s rights in any patent claims that are infringed by (i) modifications+to the Software made by you or any third party or (ii) the Software in+combination with any software or other technology.++The license granted hereunder will terminate, automatically and without notice,+if you (or any of your subsidiaries, corporate affiliates or agents) initiate+directly or indirectly, or take a direct financial interest in, any Patent+Assertion: (i) against Facebook or any of its subsidiaries or corporate+affiliates, (ii) against any party if such Patent Assertion arises in whole or+in part from any software, technology, product or service of Facebook or any of+its subsidiaries or corporate affiliates, or (iii) against any party relating+to the Software. Notwithstanding the foregoing, if Facebook or any of its+subsidiaries or corporate affiliates files a lawsuit alleging patent+infringement against you in the first instance, and you respond by filing a+patent infringement counterclaim in that lawsuit against that party that is+unrelated to the Software, the license granted here under will not terminate+under section (i) of this paragraph due to such counterclaim.++A "Necessary Claim" is a claim of a patent owned by Facebook that is+necessarily infringed by the Software standing alone.++A "Patent Assertion" is any lawsuit or other action alleging direct, indirect,+or contributory infringement or inducement to infringe any patent, including a+cross-claim or counterclaim.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,29 @@+name:                ghc-hotswap+version:             0.1.0.0+synopsis:            Library for hot-swapping shared objects in GHC+description:+  Convenience API for safely hot-swapping shared objects using GHC's GHCi linker+homepage:            https://github.com/fbsamples/ghc-hotswap+bug-reports:         https://github.com/fbsamples/ghc-hotswap/issues+license:             OtherLicense+license-files:       LICENSE,PATENTS+author:              Facebook, Inc.+maintainer:          The Haxl Team <haxl-team@fb.com>+copyright:           (c) 2017-present, Facebook, Inc. All rights reserved.+category:            System+build-type:          Simple+cabal-version:       >=1.10+stability:           alpha++library+  exposed-modules:     GHC.Hotswap+  build-depends:       base >= 4.9.1.0 && < 5.0+                     , concurrent-extra >= 0.7.0.11 && < 0.8+                     , deepseq >= 1.4.2.0 && < 1.5+                     , ghci >= 8.2 && < 8.6++  default-language:    Haskell2010++source-repository head+  type:     git+  location: https://github.com/fbsamples/ghc-hotswap/ghc-hotswap