From: simonmar <unknown>
Date: Mon, 13 Aug 2001 15:44:38 +0000 (+0000)
Subject: [project @ 2001-08-13 15:44:38 by simonmar]
X-Git-Tag: Approximately_9120_patches~1274
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=d246ceb8595cd2466127aae3dfcbd657a4d6fa08;p=ghc-hetmet.git

[project @ 2001-08-13 15:44:38 by simonmar]
The compilation manager now continues gracefully (by unloading all the
modules) if the link step fails.
---

diff --git a/ghc/compiler/compMan/CmLink.lhs b/ghc/compiler/compMan/CmLink.lhs
index e2bac19..b99c5ff 100644
--- a/ghc/compiler/compMan/CmLink.lhs
+++ b/ghc/compiler/compMan/CmLink.lhs
@@ -28,7 +28,6 @@ import Interpreter
 import DriverPipeline
 import CmTypes
 import HscTypes		( GhciMode(..) )
-import Outputable	( SDoc )
 import Name		( Name )
 import Module		( ModuleName )
 import FiniteMap
@@ -199,8 +198,8 @@ unload Interactive dflags linkables pls = panic "CmLink.unload: no interpreter"
 -- Linking
 
 data LinkResult
-   = LinkOK   PersistentLinkerState
-   | LinkErrs PersistentLinkerState [SDoc]
+   = LinkOK     PersistentLinkerState
+   | LinkFailed PersistentLinkerState
 
 link :: GhciMode		-- interactive or batch
      -> DynFlags		-- dynamic flags
@@ -270,7 +269,13 @@ link' Interactive dflags batch_attempt_linking linkables pls
 	    writeIORef v_ObjectsLoaded objs_loaded'
 
 	    -- resolve symbols within the object files
-	    resolveObjs
+	    ok <- resolveObjs
+	    -- if resolving failed, unload all our object modules and
+	    -- carry on.
+	    if (not ok)
+               then do pls <- unload Interactive dflags [] pls
+		       return (LinkFailed pls)
+	       else do
 
 	    -- finally link the interpreted linkables
 	    linkBCOs bcos [] pls
diff --git a/ghc/compiler/compMan/CompManager.lhs b/ghc/compiler/compMan/CompManager.lhs
index c03b2a0..dd5841e 100644
--- a/ghc/compiler/compMan/CompManager.lhs
+++ b/ghc/compiler/compMan/CompManager.lhs
@@ -525,30 +525,30 @@ cmLoadModule cmstate1 rootnames
 
 
 -- Finish up after a cmLoad.
---
+
+-- If the link failed, unload everything and return.
+cmLoadFinish ok (LinkFailed pls) hst hit ui mods ghci_mode pcs = do
+  dflags <- getDynFlags
+  new_pls <- CmLink.unload ghci_mode dflags [] pls 
+  new_state <- cmInit ghci_mode
+  return (new_state{ pcs=pcs, pls=new_pls }, False, [])
+
 -- Empty the interactive context and set the module context to the topmost
 -- newly loaded module, or the Prelude if none were loaded.
-cmLoadFinish ok linkresult hst hit ui mods ghci_mode pcs
-  = do case linkresult of {
-          LinkErrs _ _ -> panic "cmLoadModule: link failed (2)";
-          LinkOK pls   -> do
-
-       def_mod <- readIORef defaultCurrentModule
+cmLoadFinish ok (LinkOK pls) hst hit ui mods ghci_mode pcs
+  = do def_mod <- readIORef defaultCurrentModule
        let current_mod = case mods of 
 				[]    -> def_mod
 				(x:_) -> ms_mod x
 
        	   new_ic = emptyInteractiveContext current_mod
 
-           new_cmstate = CmState{ hst=hst, hit=hit, 
-                                  ui=ui, mg=mods,
-                                  gmode=ghci_mode, pcs=pcs, 
-				  pls=pls,
+           new_cmstate = CmState{ hst=hst, hit=hit, ui=ui, mg=mods,
+                                  gmode=ghci_mode, pcs=pcs, pls=pls,
 				  ic = new_ic }
            mods_loaded = map (moduleNameUserString.name_of_summary) mods
 
        return (new_cmstate, ok, mods_loaded)
-    }
 
 -- used to fish out the preprocess output files for the purposes
 -- of cleaning up.