51 lines
1.5 KiB
Haskell
51 lines
1.5 KiB
Haskell
{-# LANGUAGE MagicHash #-}
|
||
{-# LANGUAGE UnboxedTuples #-}
|
||
|
||
module IRC.Plugins.Loader ( load ) where
|
||
|
||
import qualified Data.HashMap.Lazy as M
|
||
|
||
import Control.Exception ( catch, ErrorCall )
|
||
import GHC.Exts ( addrToAny# )
|
||
import GHC.Ptr ( Ptr(..) )
|
||
import System.Info ( os, arch )
|
||
import GHCi.ObjLink
|
||
import Encoding
|
||
|
||
type PluginSet = M.HashMap String Plugin
|
||
|
||
data Plugin = Plugin { wew :: Int,
|
||
lad :: Int }
|
||
|
||
load :: PluginSet -> IO (Either String (IO PluginSet))
|
||
load = 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 :: String -> IO PluginSet
|
||
unload plugin = catch (unloadObj $ plugin <> ".o") exceptionHandler
|
||
|
||
exceptionHandler :: ErrorCall -> IO PluginSet
|
||
exceptionHandler _ = return ()
|
||
|
||
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",_) -> "_"
|
||
_ -> ""
|