<commit_before>%
% (c) The University of Glasgow 2005
%

-- --------------------------------------
-- 	The dynamic linker for GHCi      
-- --------------------------------------

This module deals with the top-level issues of dynamic linking,
calling the object-code linker and the byte-code linker where
necessary.


\begin{code}

{-# OPTIONS -optc-DNON_POSIX_SOURCE -#include "Linker.h" #-}

module Linker ( HValue, showLinkerState,
		linkExpr, unload, extendLinkEnv, withExtendedLinkEnv,
                extendLoadedPkgs,
		linkPackages,initDynLinker
	) where

#include "HsVersions.h"

import ObjLink		( loadDLL, loadObj, unloadObj, resolveObjs, initObjLinker )
import ByteCodeLink	( HValue, ClosureEnv, extendClosureEnv, linkBCO )
import ByteCodeItbls	( ItblEnv )
import ByteCodeAsm	( CompiledByteCode(..), bcoFreeNames, UnlinkedBCO(..))

import Packages
import DriverPhases	( isObjectFilename, isDynLibFilename )
import Finder		( findModule, findObjectLinkableMaybe, FindResult(..) )
import HscTypes
import Name		( Name, nameModule, isExternalName, isWiredInName )
import NameEnv
import NameSet		( nameSetToList )
import Module
import ListSetOps	( minusList )
import DynFlags		( DynFlags(..), getOpts )
import BasicTypes	( SuccessFlag(..), succeeded, failed )
import Outputable
import Panic            ( GhcException(..) )
import Util             ( zipLazy, global, joinFileExt, joinFileName, suffixOf )
import StaticFlags	( v_Ld_inputs )
import ErrUtils         ( debugTraceMsg )

-- Standard libraries
import Control.Monad	( when, filterM, foldM )

import Data.IORef	( IORef, readIORef, writeIORef, modifyIORef )
import Data.List	( partition, nub )

import System.IO	( putStr, putStrLn, hPutStrLn, stderr, fixIO )
import System.Directory	( doesFileExist )

import Control.Exception ( block, throwDyn, bracket )
import Maybe		( isJust, fromJust )

#if __GLASGOW_HASKELL__ >= 503
import GHC.IOBase	( IO(..) )
#else
import PrelIOBase	( IO(..) )
#endif
\end{code}


%************************************************************************
%*									*
			The Linker's state
%*									*
%************************************************************************

The persistent linker state *must* match the actual state of the 
C dynamic linker at all times, so we keep it in a private global variable.


The PersistentLinkerState maps Names to actual closures (for
interpreted code only), for use during linking.

\begin{code}
GLOBAL_VAR(v_PersistentLinkerState, panic "Dynamic linker not initialised", PersistentLinkerState)
GLOBAL_VAR(v_InitLinkerDone, False, Bool)	-- Set True when dynamic linker is initialised

data PersistentLinkerState
   = PersistentLinkerState {

	-- Current global mapping from Names to their true values
        closure_env :: ClosureEnv,

	-- The current global mapping from RdrNames of DataCons to
	-- info table addresses.
	-- When a new Unlinked is linked into the running image, or an existing
	-- module in the image is replaced, the itbl_env must be updated
	-- appropriately.
        itbl_env    :: ItblEnv,

	-- The currently loaded interpreted modules (home package)
	bcos_loaded :: [Linkable],

	-- And the currently-loaded compiled modules (home package)
	objs_loaded :: [Linkable],

	-- The currently-loaded packages; always object code
	-- Held, as usual, in dependency order; though I am not sure if
	-- that is really important
	pkgs_loaded :: [PackageId]
     }

emptyPLS :: DynFlags -> PersistentLinkerState
emptyPLS dflags = PersistentLinkerState { 
			closure_env = emptyNameEnv,
			itbl_env    = emptyNameEnv,
			pkgs_loaded = init_pkgs,
			bcos_loaded = [],
			objs_loaded = [] }
  -- Packages that don't need loading, because the compiler 
  -- shares them with the interpreted program.
  --
  -- The linker's symbol table is populated with RTS symbols using an
  -- explicit list.  See rts/Linker.c for details.
  where init_pkgs
	  | ExtPackage rts_id <- rtsPackageId (pkgState dflags) = [rts_id]
	  | otherwise = []
\end{code}

\begin{code}
extendLoadedPkgs :: [PackageId] -> IO ()
extendLoadedPkgs pkgs
    = modifyIORef v_PersistentLinkerState (\s -> s{pkgs_loaded = pkgs ++ pkgs_loaded s})

extendLinkEnv :: [(Name,HValue)] -> IO ()
-- Automatically discards shadowed bindings
extendLinkEnv new_bindings
  = do	pls <- readIORef v_PersistentLinkerState
	let new_closure_env = extendClosureEnv (closure_env pls) new_bindings
	    new_pls = pls { closure_env = new_closure_env }
	writeIORef v_PersistentLinkerState new_pls

withExtendedLinkEnv :: [(Name,HValue)] -> IO a -> IO a
withExtendedLinkEnv new_env action
    = bracket set_new_env
              reset_old_env
              (const action)
    where set_new_env = do pls <- readIORef v_PersistentLinkerState
                           let new_closure_env = extendClosureEnv (closure_env pls) new_env
                               new_pls = pls { closure_env = new_closure_env }
                           writeIORef v_PersistentLinkerState new_pls
                           return pls
          reset_old_env pls = writeIORef v_PersistentLinkerState pls

-- filterNameMap removes from the environment all entries except 
-- 	those for a given set of modules;
-- Note that this removes all *local* (i.e. non-isExternal) names too 
--	(these are the temporary bindings from the command line).
-- Used to filter both the ClosureEnv and ItblEnv

filterNameMap :: [Module] -> NameEnv (Name, a) -> NameEnv (Name, a)
filterNameMap mods env 
   = filterNameEnv keep_elt env
   where
     keep_elt (n,_) = isExternalName n 
		      && (nameModule n `elem` mods)
\end{code}

<commit_msg>Fix minor bug in Linker.withExtendedLinkEnv<commit_after>%
% (c) The University of Glasgow 2005
%

-- --------------------------------------
-- 	The dynamic linker for GHCi      
-- --------------------------------------

This module deals with the top-level issues of dynamic linking,
calling the object-code linker and the byte-code linker where
necessary.


\begin{code}

{-# OPTIONS -optc-DNON_POSIX_SOURCE -#include "Linker.h" #-}

module Linker ( HValue, showLinkerState,
		linkExpr, unload, extendLinkEnv, withExtendedLinkEnv,
                extendLoadedPkgs,
		linkPackages,initDynLinker
	) where

#include "HsVersions.h"

import ObjLink		( loadDLL, loadObj, unloadObj, resolveObjs, initObjLinker )
import ByteCodeLink	( HValue, ClosureEnv, extendClosureEnv, linkBCO )
import ByteCodeItbls	( ItblEnv )
import ByteCodeAsm	( CompiledByteCode(..), bcoFreeNames, UnlinkedBCO(..))

import Packages
import DriverPhases	( isObjectFilename, isDynLibFilename )
import Finder		( findModule, findObjectLinkableMaybe, FindResult(..) )
import HscTypes
import Name		( Name, nameModule, isExternalName, isWiredInName )
import NameEnv
import NameSet		( nameSetToList )
import Module
import ListSetOps	( minusList )
import DynFlags		( DynFlags(..), getOpts )
import BasicTypes	( SuccessFlag(..), succeeded, failed )
import Outputable
import Panic            ( GhcException(..) )
import Util             ( zipLazy, global, joinFileExt, joinFileName, suffixOf )
import StaticFlags	( v_Ld_inputs )
import ErrUtils         ( debugTraceMsg )

-- Standard libraries
import Control.Monad	( when, filterM, foldM )

import Data.IORef	( IORef, readIORef, writeIORef, modifyIORef )
import Data.List	( partition, nub )

import System.IO	( putStr, putStrLn, hPutStrLn, stderr, fixIO )
import System.Directory	( doesFileExist )

import Control.Exception ( block, throwDyn, bracket )
import Maybe		( isJust, fromJust )

#if __GLASGOW_HASKELL__ >= 503
import GHC.IOBase	( IO(..) )
#else
import PrelIOBase	( IO(..) )
#endif
\end{code}


%************************************************************************
%*									*
			The Linker's state
%*									*
%************************************************************************

The persistent linker state *must* match the actual state of the 
C dynamic linker at all times, so we keep it in a private global variable.


The PersistentLinkerState maps Names to actual closures (for
interpreted code only), for use during linking.

\begin{code}
GLOBAL_VAR(v_PersistentLinkerState, panic "Dynamic linker not initialised", PersistentLinkerState)
GLOBAL_VAR(v_InitLinkerDone, False, Bool)	-- Set True when dynamic linker is initialised

data PersistentLinkerState
   = PersistentLinkerState {

	-- Current global mapping from Names to their true values
        closure_env :: ClosureEnv,

	-- The current global mapping from RdrNames of DataCons to
	-- info table addresses.
	-- When a new Unlinked is linked into the running image, or an existing
	-- module in the image is replaced, the itbl_env must be updated
	-- appropriately.
        itbl_env    :: ItblEnv,

	-- The currently loaded interpreted modules (home package)
	bcos_loaded :: [Linkable],

	-- And the currently-loaded compiled modules (home package)
	objs_loaded :: [Linkable],

	-- The currently-loaded packages; always object code
	-- Held, as usual, in dependency order; though I am not sure if
	-- that is really important
	pkgs_loaded :: [PackageId]
     }

emptyPLS :: DynFlags -> PersistentLinkerState
emptyPLS dflags = PersistentLinkerState { 
			closure_env = emptyNameEnv,
			itbl_env    = emptyNameEnv,
			pkgs_loaded = init_pkgs,
			bcos_loaded = [],
			objs_loaded = [] }
  -- Packages that don't need loading, because the compiler 
  -- shares them with the interpreted program.
  --
  -- The linker's symbol table is populated with RTS symbols using an
  -- explicit list.  See rts/Linker.c for details.
  where init_pkgs
	  | ExtPackage rts_id <- rtsPackageId (pkgState dflags) = [rts_id]
	  | otherwise = []
\end{code}

\begin{code}
extendLoadedPkgs :: [PackageId] -> IO ()
extendLoadedPkgs pkgs
    = modifyIORef v_PersistentLinkerState (\s -> s{pkgs_loaded = pkgs ++ pkgs_loaded s})

extendLinkEnv :: [(Name,HValue)] -> IO ()
-- Automatically discards shadowed bindings
extendLinkEnv new_bindings
  = do	pls <- readIORef v_PersistentLinkerState
	let new_closure_env = extendClosureEnv (closure_env pls) new_bindings
	    new_pls = pls { closure_env = new_closure_env }
	writeIORef v_PersistentLinkerState new_pls

withExtendedLinkEnv :: [(Name,HValue)] -> IO a -> IO a
withExtendedLinkEnv new_env action
    = bracket set_new_env
              reset_old_env
              (const action)
    where set_new_env = do pls <- readIORef v_PersistentLinkerState
                           let new_closure_env = extendClosureEnv (closure_env pls) new_env
                               new_pls = pls { closure_env = new_closure_env }
                           writeIORef v_PersistentLinkerState new_pls
                           return (closure_env pls)
          reset_old_env env = modifyIORef v_PersistentLinkerState (\pls -> pls{ closure_env = env })

-- filterNameMap removes from the environment all entries except 
-- 	those for a given set of modules;
-- Note that this removes all *local* (i.e. non-isExternal) names too 
--	(these are the temporary bindings from the command line).
-- Used to filter both the ClosureEnv and ItblEnv

filterNameMap :: [Module] -> NameEnv (Name, a) -> NameEnv (Name, a)
filterNameMap mods env 
   = filterNameEnv keep_elt env
   where
     keep_elt (n,_) = isExternalName n 
		      && (nameModule n `elem` mods)
\end{code}


{'fraction_non_alphanumeric': 0.11883209087681931, 'fraction_numerical': 0.0012424565140220093, 'mean_word_length': 3.4036733098866745, 'pattern_counts': {'":': 0, '<': 9, '<?xml version=': 0, '>': 22, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '4004156', 'n_tokens_mistral': 3611, 'n_tokens_neox': 3376, 'n_words': 1072}