Hi all, I'm working on how to dynamic loading library into *running* program. I can dynamic loading/update module into *running* program if have *new* package installed. Example, when program *startup* and loading package foo-0.0.1 with function : api :: String -> String api = reverse then, i change `api` and install by foo-0.0.2: api :: String -> String api = show . length and dynamic-linking foo-0.0.2 works fine, i change api's value in *runtime*. And problem is, my solution just work when you install *new* package in Cabal/GHC database (foo-0.0.1 => foo-0.0.2), if i just change `api` value and don't install *new* package, my code can't work. I use Linker.linkPackages and Linker.getHValue to get symbol value, but looks Linker.getHValue can't get *update* value once current package has linked in memory. So how to make Linker.getHValue can get *update* value and don't need install *new* package in Cabal/GHC database? How to *reload* module with current version package? Or any GHC-API missing? Below is my source code, you just need look function `load`. Thanks! :) -- Andy ------------------------------> source code start <------------------------------ module System.Dynload ( PackageVersion (..), dynload ) where import Control.Monad (forM_) import Data.IORef import GHC.Paths (libdir) import MonadUtils (liftIO) import Data.List import Data.Ord import Distribution.Package import qualified DynFlags import qualified Exception import qualified GHC import qualified HscTypes import qualified IOEnv import qualified Linker import qualified LoadIface import qualified Maybes import qualified Module import qualified Name import qualified OccName import qualified Outputable import qualified PackageConfig as PC import qualified Packages import qualified SrcLoc import qualified TcRnTypes import qualified UniqSupply import qualified Unique data PackageVersion = Newest | Version String deriving (Ord, Show, Eq) dynload :: (String, PackageVersion, String, [(String, Linker.HValue -> IO ())]) -> IO () dynload (packageName, packageVersion, moduleName, loadList) = GHC.defaultErrorHandler DynFlags.defaultDynFlags $ GHC.runGhc (Just libdir) $ do -- Update Flags of session. sessionFlags <- GHC.getSessionDynFlags GHC.setSessionDynFlags sessionFlags -- this is ncessary, otherwise get GHC error -- Initialise package information. (flags, _) <- liftIO $ Packages.initPackages sessionFlags -- Search packages that export modules. let packages = map fst $ filter snd $ Packages.lookupModuleInAllPackages flags (Module.mkModuleName moduleName) exportError pName mName = "# Package " ++ pName ++ " not exist or not export module " ++ mName result = case packages of [] -> Left $ "# No package export module : " ++ moduleName _ -> let matchPackages = filter (\x -> packageConfigName x == packageName) packages in case matchPackages of [] -> Left $ exportError packageName moduleName _ -> case packageVersion of Version pv -> let pName = packageName ++ "-" ++ pv versions = map packageConfigVersion matchPackages in if pv `elem` versions then Right pName else Left $ exportError pName moduleName Newest -> case findNewestPackage matchPackages of Nothing -> Left "# dynload : Impossible reach here" Just packageConfig -> Right $ packageConfigIdString packageConfig case result of Left err -> liftIO $ putStrLn err Right packageNameStr -> do liftIO $ putStrLn $ "* Use package : " ++ packageNameStr -- Initialise the dynamic linker. liftIO $ Linker.initDynLinker flags hscEnv <- GHC.getSession forM_ loadList $ \ (symbolName, loadFun) -> do -- Because symbol perhaps re-export from external module. -- So we need parse symbol to find define location. parseResult <- liftIO $ parseSymbol (packageNameStr, moduleName, symbolName) hscEnv flags case parseResult of Just args -> load args flags loadFun Nothing -> return () -- | Internal load function for pdynload. load :: (GHC.GhcMonad m) => (String, String, String) -> GHC.DynFlags -> (Linker.HValue -> IO ()) -> m () load (packageName, moduleName, symbolName) flags loadFun = Exception.ghandle (\(GHC.CmdLineError _) -> -- Catch package error. liftIO $ putStrLn $ "# Unknown package " ++ packageName) (do -- Debug code. -- liftIO $ Linker.showLinkerState -- Link exactly the specified packages, and their dependents -- (unless of course they are already linked). -- The dependents are linked automatically, -- and it doesn't matter what order you specify the input packages. let packageId = Module.stringToPackageId packageName liftIO $ Linker.linkPackages flags [packageId] Exception.ghandle (\(GHC.ProgramError err) -> liftIO $ putStrLn $ "# " ++ err) (do liftIO $ putStrLn $ "* Linking " ++ packageName ++ ":" ++ moduleName ++ "." ++ symbolName ++ " ..." -- Get current session. session <- GHC.getSession -- Create a name which definitely originates in the given module. let name = Name.mkExternalName (Unique.mkBuiltinUnique 0) (Module.mkModule packageId (Module.mkModuleName moduleName)) (OccName.mkVarOcc symbolName) SrcLoc.noSrcSpan -- Get the HValue associated with the given name. -- May cause loading the module that contains the name. result <- liftIO $ Linker.getHValue session name liftIO $ loadFun result)) -- | Parse symbol whether defined in current module. -- If symbol is re-export other module, parse recursively, -- until found the define location of symbol. parseSymbol :: (String, String, String) -> HscTypes.HscEnv -> GHC.DynFlags -> IO (Maybe (String, String, String)) parseSymbol (packageName, moduleName, symbolName) hscEnv flags = do putStrLn $ "* Parse " ++ packageName ++ ":" ++ moduleName ++ "." ++ symbolName ++ " ..." -- Build unique supply to build environment. uniqueSupply <- UniqSupply.mkSplitUniqSupply 'a' uniqueSupplyIORef <- newIORef uniqueSupply -- Initialise. let packageId = Module.stringToPackageId packageName module' = Module.mkModule packageId $ Module.mkModuleName moduleName environment = TcRnTypes.Env { TcRnTypes.env_top = hscEnv, TcRnTypes.env_us = uniqueSupplyIORef, TcRnTypes.env_gbl = (), TcRnTypes.env_lcl = ()} -- Find and read interface file. iface <- IOEnv.runIOEnv environment $ LoadIface.findAndReadIface Outputable.empty module' False case iface of -- Return Nothing if can't found interface file. Maybes.Failed _ -> do putStrLn $ "# Can't found interface file of " ++ packageName ++ ":" ++ moduleName ++ "." ++ symbolName return Nothing -- Parse symbol. Maybes.Succeeded (moduleInterface, hiFile) -> do putStrLn $ "* Scan interface file " ++ hiFile ++ " ..." -- Export list of current module let ifaceExport = HscTypes.mi_exports moduleInterface -- [(ModuleName, [type])] exports = map (\ (mod, items) -> (Module.moduleNameString $ Module.moduleName mod ,concatMap (\item -> case item of HscTypes.Avail name -> [OccName.occNameString name] HscTypes.AvailTC _ list -> map OccName.occNameString list ) items) ) ifaceExport -- Partition current module and external module. (currentExports, otherExports) = partition (\ (mName, _) -> mName == moduleName) exports case findSymbolInExportList currentExports symbolName of -- Return current module if found symbol in export list of current module. Just _ -> do putStrLn $ "* '" ++ symbolName ++ "' defined in " ++ packageName ++ ":" ++ moduleName return $ Just (packageName, moduleName, symbolName) Nothing -> -- Parse recursively if symbol is re-export from external module. case findSymbolInExportList otherExports symbolName of Just mn -> do putStrLn $ "* '" ++ symbolName ++ "' is re-export from module " ++ mn -- Lookup new package of external module. newPackageName <- do putStrLn $ "* Lookup package of module " ++ mn lookupPackageName flags mn case newPackageName of -- Parse symbol in new package. Just npn -> parseSymbol (npn, mn, symbolName) hscEnv flags -- Return Nothing if package not found. Nothing -> return Nothing -- Return Nothing if can't found symbol in interface file. -- If reach this, interface file is incorrect. Nothing -> do putStrLn $ "# Can't found symbol " ++ symbolName ++ " in " ++ hiFile return Nothing -- | Lookup package name from ghc database. lookupPackageName :: DynFlags.DynFlags -> String -> IO (Maybe String) lookupPackageName flags moduleName -- Return Nothing when no package found. | packageNum == 0 = do putStrLn $ "# Can't found module " ++ show moduleName return Nothing | packageNum == 1 = do let (packageConfig, isExpose) = head packages pName = packageConfigIdString packageConfig if isExpose -- Return package name when package expose module. then return $ Just pName -- Return Nothing if module hide in package. else do putStrLn $ "# Module " ++ show moduleName ++ " hide in package " ++ pName return Nothing -- Return Nothing if no package expose module. | null exposePackages = do putStrLn $ "# Can't found module " ++ show moduleName return Nothing -- Return first match package when found module in multiple packages. | otherwise = case findNewestPackage exposePackages of Nothing -> do putStrLn "# lookupPackageName: Impossible reach here" return Nothing Just packageConfig -> do let pName = packageConfigIdString packageConfig putStrLn $ "# Module " ++ moduleName ++ " expose in multiple packages." putStrLn $ "* Use package : " ++ pName return $ Just pName where packages -- search package that *contain* module. = Packages.lookupModuleInAllPackages flags (Module.mkModuleName moduleName) packageNum -- length of package list = length packages exposePackages -- filter package that *export* module = map fst $ filter snd packages -- | Find symbol in export list of module. -- Return module name when found symbol in export list. -- Otherwise return Nothing. findSymbolInExportList :: Eq b => [(a, [b])] -> b -> Maybe a findSymbolInExportList [] _ = Nothing findSymbolInExportList ((moduleName, symList) :xs) sym | sym `elem` symList = Just moduleName | otherwise = findSymbolInExportList xs sym -- | Get PackageConfig id string. packageConfigIdString :: PC.PackageConfig -> String packageConfigIdString = Module.packageIdString . PC.packageConfigId -- | The package name of PC. packageConfigName :: PC.PackageConfig -> String packageConfigName packageConfig = packageName where (PackageName packageName) = PC.pkgName $ PC.sourcePackageId packageConfig -- | The package version of PC. packageConfigVersion :: PC.PackageConfig -> String packageConfigVersion = showVersion . PC.versionBranch . PC.pkgVersion . PC.sourcePackageId -- | Find newest package. findNewestPackage :: [PC.PackageConfig] -> Maybe PC.PackageConfig findNewestPackage [] = Nothing findNewestPackage [a] = Just a findNewestPackage xs = Just $ maximumBy (comparing (PC.pkgVersion . PC.sourcePackageId)) xs -- | Convert version [x,y,z] to "x.y.z". showVersion :: [Int] -> String showVersion [] = "" showVersion [x] = show x showVersion (x:xs) = (show x ++ ".") ++ showVersion xs ------------------------------> source code end <------------------------------