X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fghci%2FLinker.lhs;h=459fbd9e908c48431b468241805f70b7869ace8a;hb=3d73e45b0909b9669d4679cbda29fa2b17b98d2e;hp=ac92975259b451ea1f942e7edded4764d49725a4;hpb=a11bb49b97eaba892730baf1565e922715dbc07f;p=ghc-hetmet.git

diff --git a/compiler/ghci/Linker.lhs b/compiler/ghci/Linker.lhs
index ac92975..459fbd9 100644
--- a/compiler/ghci/Linker.lhs
+++ b/compiler/ghci/Linker.lhs
@@ -14,6 +14,9 @@ necessary.
 \begin{code}
 {-# OPTIONS -optc-DNON_POSIX_SOURCE -#include "Linker.h" #-}
 
+{-# OPTIONS -fno-cse #-}
+-- -fno-cse is needed for GLOBAL_VAR's to behave properly
+
 module Linker ( HValue, getHValue, showLinkerState,
 		linkExpr, unload, withExtendedLinkEnv,
                 extendLinkEnv, deleteFromLinkEnv,
@@ -72,9 +75,9 @@ import System.FilePath
 import System.IO
 import System.Directory
 
-import Distribution.Package hiding (depends)
+import Distribution.Package hiding (depends, PackageId)
 
-import Control.Exception
+import Exception
 import Data.Maybe
 \end{code}
 
@@ -260,7 +263,7 @@ getHValue :: HscEnv -> Name -> IO HValue
 getHValue hsc_env name = do
    when (isExternalName name) $ do
         ok <- linkDependencies hsc_env noSrcSpan [nameModule name]
-        when (failed ok) $ throwDyn (ProgramError "")
+        when (failed ok) $ ghcError (ProgramError "")
    pls <- readIORef v_PersistentLinkerState
    lookupName (closure_env pls) name
         
@@ -410,7 +413,7 @@ reallyInitDynLinker dflags
 	; ok <- resolveObjs
 
 	; if succeeded ok then maybePutStrLn dflags "done"
-	  else throwDyn (InstallationError "linking extra libraries/objects failed")
+	  else ghcError (InstallationError "linking extra libraries/objects failed")
 	}}
 
 classifyLdInput :: FilePath -> IO (Maybe LibrarySpec)
@@ -466,7 +469,7 @@ preloadLib dflags lib_paths framework_paths lib_spec
             if not b then return False
                      else loadObj name >> return True
     
-    give_up = throwDyn $ 
+    give_up = ghcError $ 
 	      CmdLineError "user specified .o/.so/.DLL could not be loaded."
 \end{code}
 
@@ -497,7 +500,7 @@ linkExpr hsc_env span root_ul_bco
 	-- Link the packages and modules required
    ; ok <- linkDependencies hsc_env span needed_mods
    ; if failed ok then
-	throwDyn (ProgramError "")
+	ghcError (ProgramError "")
      else do {
 
 	-- Link the expression itself
@@ -523,7 +526,7 @@ linkExpr hsc_env span root_ul_bco
 	-- by default, so we can safely ignore them here.
  
 dieWith :: SrcSpan -> Message -> IO a
-dieWith span msg = throwDyn (ProgramError (showSDoc (mkLocMessage span msg)))
+dieWith span msg = ghcError (ProgramError (showSDoc (mkLocMessage span msg)))
 
 
 checkNonStdWay :: DynFlags -> SrcSpan -> IO (Maybe String)
@@ -620,7 +623,7 @@ getLinkDeps hsc_env hpt _ maybe_normal_osuf span mods
 
 
     link_boot_mod_error mod = 
-        throwDyn (ProgramError (showSDoc (
+        ghcError (ProgramError (showSDoc (
             text "module" <+> ppr mod <+> 
             text "cannot be linked; it is only available as a boot module")))
 
@@ -996,7 +999,7 @@ linkPackages dflags new_pkgs
 	     ; return (new_pkg : pkgs') }
 
 	| otherwise
-	= throwDyn (CmdLineError ("unknown package: " ++ packageIdString new_pkg))
+	= ghcError (CmdLineError ("unknown package: " ++ packageIdString new_pkg))
 
 
 linkPackage :: DynFlags -> PackageConfig -> IO ()
@@ -1046,13 +1049,13 @@ linkPackage dflags pkg
         maybePutStr dflags "linking ... "
         ok <- resolveObjs
 	if succeeded ok then maybePutStrLn dflags "done."
-	      else throwDyn (InstallationError ("unable to load package `" ++ display (package pkg) ++ "'"))
+	      else ghcError (InstallationError ("unable to load package `" ++ display (package pkg) ++ "'"))
 
 load_dyn :: [FilePath] -> FilePath -> IO ()
 load_dyn dirs dll = do r <- loadDynamic dirs dll
 		       case r of
 			 Nothing  -> return ()
-			 Just err -> throwDyn (CmdLineError ("can't load .so/.DLL for: " 
+			 Just err -> ghcError (CmdLineError ("can't load .so/.DLL for: " 
                                  			      ++ dll ++ " (" ++ err ++ ")" ))
 
 loadFrameworks :: InstalledPackageInfo_ ModuleName -> IO ()
@@ -1066,7 +1069,7 @@ loadFrameworks pkg
     load fw = do  r <- loadFramework fw_dirs fw
 		  case r of
 		    Nothing  -> return ()
-		    Just err -> throwDyn (CmdLineError ("can't load framework: " 
+		    Just err -> ghcError (CmdLineError ("can't load framework: " 
                                			        ++ fw ++ " (" ++ err ++ ")" ))
 
 -- Try to find an object file for a given library in the given paths.
@@ -1082,7 +1085,7 @@ locateOneObj dirs lib
 	    Nothing	  -> 
                 do { mb_lib_path <- findFile mk_dyn_lib_path dirs
                    ; case mb_lib_path of
-                       Just _  -> return (DLL (lib ++ "-ghc" ++ cProjectVersion))
+                       Just _  -> return (DLL dyn_lib_name)
                        Nothing -> return (DLL lib) }} -- We assume
  | otherwise
     -- When the GHC package was compiled as dynamic library (=__PIC__ set),
@@ -1097,7 +1100,8 @@ locateOneObj dirs lib
                        Nothing       -> return (DLL lib) }}		-- We assume
    where
      mk_obj_path dir = dir </> (lib <.> "o")
-     mk_dyn_lib_path dir = dir </> mkSOName (lib ++ "-ghc" ++ cProjectVersion)
+     dyn_lib_name = lib ++ "-ghc" ++ cProjectVersion
+     mk_dyn_lib_path dir = dir </> mkSOName dyn_lib_name
 
 -- ----------------------------------------------------------------------------
 -- Loading a dyanmic library (dlopen()-ish on Unix, LoadLibrary-ish on Win32)
@@ -1127,7 +1131,7 @@ mkSOName root
 -- name. They are searched for in different paths than normal libraries.
 loadFramework :: [FilePath] -> FilePath -> IO (Maybe String)
 loadFramework extraPaths rootname
-   = do { either_dir <- Control.Exception.try getHomeDirectory
+   = do { either_dir <- tryIO getHomeDirectory
         ; let homeFrameworkPath = case either_dir of
                                   Left _ -> []
                                   Right dir -> [dir ++ "/Library/Frameworks"]