|
- {-# LANGUAGE MagicHash #-}
- {-# LANGUAGE UnboxedTuples #-}
-
- module IRC.Plugins.Loader ( load ) where
-
- import qualified Data.HashMap.Lazy as M
-
- import IRC.Plugins.Plugin
-
- import Control.Exception ( catch, ErrorCall )
- import GHC.Exts ( addrToAny# )
- import GHC.Ptr ( Ptr(..) )
- import System.Info ( os, arch )
- import GHCi.ObjLink
- import Encoding
-
- load :: PluginSet -> String -> IO (Either String PluginSet)
- load set path = do
- initObjLinker RetainCAFs
- loadObj "Plugin.o"
- _ret <- resolveObjs
- ptr <- lookupSymbol (mangleSymbol Nothing "Plugin" "f")
- case ptr of
- Nothing -> return $ Left "Couldn’t load symbol"
- Just (Ptr addr) -> case addrToAny# addr of
- (# f #) -> return $ Right f
-
- unload :: PluginSet -> String -> IO PluginSet
- unload set plugin = catch unloadPlugin exceptionHandler
- where exceptionHandler :: ErrorCall -> IO PluginSet
- exceptionHandler _ = return set
-
- unloadPlugin :: IO PluginSet
- unloadPlugin = do
- unloadObj $ plugin <> ".o"
- return $ M.delete plugin set
-
- mangleSymbol :: Maybe String -> String -> String -> String
- mangleSymbol pkg module' valsym =
- prefixUnderscore <>
- maybe "" (\p -> zEncodeString p <> "_") pkg <>
- zEncodeString module' <> "_" <> zEncodeString valsym <> "_closure"
-
- prefixUnderscore :: String
- prefixUnderscore =
- case (os,arch) of
- ("mingw32","x86_64") -> ""
- ("cygwin","x86_64") -> ""
- ("mingw32",_) -> "_"
- ("darwin",_) -> "_"
- ("cygwin",_) -> "_"
- _ -> ""
|