[project @ 2000-11-20 11:39:57 by sewardj]

* (CompManager) recompile if in interactive mode and no old linkable exists
* (HscMain) don't write interface files in interactive mode
* (everywhere) switch arg order to unJust for PAP purposes

ghc/compiler/compMan/CmLink.lhs

@@ -6,7 +6,7 @@
 \begin{code}
 module CmLink ( Linkable(..),  Unlinked(..),
 		filterModuleLinkables, 
-		findModuleLinkable,
+		findModuleLinkable_maybe,
 		modname_of_linkable, is_package_linkable,
 		LinkResult(..),
                 link, 
@@ -62,11 +62,12 @@ data LinkResult
    = LinkOK   PersistentLinkerState
    | LinkErrs PersistentLinkerState [SDoc]
 
-findModuleLinkable :: [Linkable] -> ModuleName -> Linkable
-findModuleLinkable lis mod 
+findModuleLinkable_maybe :: [Linkable] -> ModuleName -> Maybe Linkable
+findModuleLinkable_maybe lis mod 
    = case [LM nm us | LM nm us <- lis, nm == mod] of
-        [li] -> li
-        other -> pprPanic "findModuleLinkable" (ppr mod)
+        []   -> Nothing
+        [li] -> Just li
+        many -> pprPanic "findModuleLinkable" (ppr mod)
 
 
 emptyPLS :: IO PersistentLinkerState

ghc/compiler/compMan/CompManager.lhs

@@ -50,7 +50,6 @@ import Directory        ( getModificationTime, doesFileExist )
 import IO
 import List		( nub )
 import Maybe		( catMaybes, fromMaybe, isJust )
-
 import PrelGHC		( unsafeCoerce# )
 \end{code}
 
@@ -256,7 +255,8 @@ cmLoadModule cmstate1 rootname
               -- we could get the relevant linkables by filtering newLis, but
               -- it seems easier to drag them out of the updated, cleaned-up UI
               let linkables_to_link 
-                     = map (findModuleLinkable ui4) mods_to_keep_names
+                     = map (unJust "linkables_to_link" . findModuleLinkable_maybe ui4)
+                           mods_to_keep_names
 
               linkresult <- link ghci_mode False linkables_to_link pls1
               case linkresult of
@@ -365,15 +365,18 @@ upsweep_mods :: GhciMode
                     [ModSummary],     -- mods which succeeded
                     [Linkable])       -- new linkables
 
-upsweep_mods ghci_mode oldUI reachable_from source_changed threaded []
+upsweep_mods ghci_mode oldUI reachable_from source_changed threaded 
+     []
    = return (True, threaded, [], [])
 
-upsweep_mods ghci_mode oldUI reachable_from source_changed threaded ((CyclicSCC ms):_)
+upsweep_mods ghci_mode oldUI reachable_from source_changed threaded 
+     ((CyclicSCC ms):_)
    = do hPutStrLn stderr ("ghc: module imports form a cycle for modules:\n\t" ++
                           unwords (map (moduleNameUserString.name_of_summary) ms))
         return (False, threaded, [], [])
 
-upsweep_mods ghci_mode oldUI reachable_from source_changed threaded ((AcyclicSCC mod):mods)
+upsweep_mods ghci_mode oldUI reachable_from source_changed threaded 
+     ((AcyclicSCC mod):mods)
    = do (threaded1, maybe_linkable) 
            <- upsweep_mod ghci_mode oldUI threaded mod 
                           (reachable_from (name_of_summary mod)) 
@@ -382,7 +385,8 @@ upsweep_mods ghci_mode oldUI reachable_from source_changed threaded ((AcyclicSCC
            Just linkable 
               -> -- No errors; do the rest
                  do (restOK, threaded2, modOKs, linkables) 
-                       <- upsweep_mods ghci_mode oldUI reachable_from source_changed threaded1 mods
+                       <- upsweep_mods ghci_mode oldUI reachable_from 
+                                       source_changed threaded1 mods
                     return (restOK, threaded2, mod:modOKs, linkable:linkables)
            Nothing -- we got a compilation error; give up now
               -> return (False, threaded1, [], [])
@@ -405,15 +409,18 @@ upsweep_mod ghci_mode oldUI threaded1 summary1
         let old_iface = lookupUFM hit1 (name_of_summary summary1)
 
         -- We *have* to compile it if we're in batch mode and we can't see
-        -- a previous linkable for it on disk.
+        -- a previous linkable for it on disk.  Or if we're in interpretive
+        -- and there's no old linkable in oldUI.
         compilation_mandatory 
-           <- if ghci_mode /= Batch then return False 
-              else case ml_obj_file (ms_location summary1) of
-                      Nothing     -> do --putStrLn "cmcm: object?!"
-                                        return True
-                      Just obj_fn -> do --putStrLn ("cmcm: old obj " ++ obj_fn)
-                                        b <- doesFileExist obj_fn
-                                        return (not b)
+           <- case ghci_mode of
+                 Batch -> case ml_obj_file (ms_location summary1) of
+                             Nothing     -> return True
+                             Just obj_fn -> do b <- doesFileExist obj_fn
+                                               return (not b)
+                 Interactive -> case findModuleLinkable_maybe oldUI mod_name of 
+                                   Nothing -> return True
+                                   Just li -> return False
+                 OneShot -> panic "upsweep_mod:compilation_mandatory"
 
         let compilation_might_be_needed 
                = source_might_have_changed || compilation_mandatory
@@ -439,11 +446,13 @@ upsweep_mod ghci_mode oldUI threaded1 summary1
                      threaded2    = CmThreaded pcs2 hst2 hit2
                      old_linkable 
                         | ghci_mode == Interactive 
-                        = findModuleLinkable oldUI mod_name
+                        = unJust "upsweep_mod(2)" 
+                                 (findModuleLinkable_maybe oldUI mod_name)
                         | otherwise
                         = LM mod_name
-                             [DotO (unJust (ml_obj_file (ms_location summary1)) 
-                                    "upsweep_mod")]
+                             [DotO (unJust "upsweep_mod(1)"
+                                           (ml_obj_file (ms_location summary1))
+                                   )]
                  in  return (threaded2, Just old_linkable)
 
            -- Compilation really did happen, and succeeded.  A new
@@ -581,7 +590,7 @@ downsweep rootNm
 summarise :: Module -> ModuleLocation -> IO ModSummary
 summarise mod location
    | isModuleInThisPackage mod
-   = do let hs_fn = unJust (ml_hs_file location) "summarise"
+   = do let hs_fn = unJust "summarise" (ml_hs_file location)
         hspp_fn <- preprocess hs_fn
         modsrc <- readFile hspp_fn
         let (srcimps,imps,mod_name) = getImports modsrc

ghc/compiler/main/DriverPipeline.hs

 -----------------------------------------------------------------------------
--- $Id: DriverPipeline.hs,v 1.30 2000/11/19 19:40:08 simonmar Exp $
+-- $Id: DriverPipeline.hs,v 1.31 2000/11/20 11:39:57 sewardj Exp $
 --
 -- GHC Driver
 --
@@ -778,8 +778,8 @@ compile ghci_mode summary source_unchanged old_iface hst hit pcs = do
    writeIORef v_Driver_state init_driver_state
 
    let location   = ms_location summary   
-   let input_fn   = unJust (ml_hs_file location) "compile:hs"
-   let input_fnpp = unJust (ml_hspp_file location) "compile:hspp"
+   let input_fn   = unJust "compile:hs" (ml_hs_file location) 
+   let input_fnpp = unJust "compile:hspp" (ml_hspp_file location)
 
    when verb (hPutStrLn stderr ("compile: input file " ++ input_fnpp))
 

ghc/compiler/main/GetImports.hs

 -----------------------------------------------------------------------------
--- $Id: GetImports.hs,v 1.2 2000/11/17 13:33:17 sewardj Exp $
+-- $Id: GetImports.hs,v 1.3 2000/11/20 11:39:57 sewardj Exp $
 --
 -- GHC Driver program
 --
@@ -18,7 +18,7 @@ getImports s
    = f [{-accum source imports-}] [{-accum normal imports-}] 
        (mkModuleName "Main") (words (clean s))
      where
-        f si ni _  ("module" : me : ws) = f si ni (mkModuleName me) ws
+        f si ni _  ("module" : me : ws) = f si ni (mkMN me) ws
 
 	f si ni me ("foreign" : "import" : ws) = f si ni me ws
         f si ni me ("import" : "{-#" : "SOURCE" : "#-}" : "qualified" : m : ws) 

ghc/compiler/main/HscMain.lhs

@@ -103,7 +103,7 @@ hscMain ghci_mode dflags source_unchanged location maybe_old_iface hst hit pcs
 
       (pcs_ch, errs_found, (recomp_reqd, maybe_checked_iface))
          <- checkOldIface dflags hit hst pcs 
-		(unJust (ml_hi_file location) "hscMain")
+		(unJust "hscMain" (ml_hi_file location))
 		source_unchanged maybe_old_iface;
 
       if errs_found then
@@ -172,8 +172,8 @@ hscRecomp ghci_mode dflags location maybe_checked_iface hst hit pcs_ch
  	    -------------------
  	    -- PARSE
  	    -------------------
-	; maybe_parsed <- myParseModule dflags (unJust (ml_hspp_file location) 
-                                                       "hscRecomp:hspp")
+	; maybe_parsed <- myParseModule dflags 
+                             (unJust "hscRecomp:hspp" (ml_hspp_file location))
 	; case maybe_parsed of {
       	     Nothing -> return (HscFail pcs_ch);
       	     Just rdr_module -> do {
@@ -223,8 +223,8 @@ hscRecomp ghci_mode dflags location maybe_checked_iface hst hit pcs_ch
  	    -------------------
 	; let new_details = mkModDetails env_tc local_insts tidy_binds 
  					 top_level_ids orphan_rules
-	; final_iface <- mkFinalIface dflags location maybe_checked_iface 
-				      new_iface new_details
+	; final_iface <- mkFinalIface ghci_mode dflags location 
+                                      maybe_checked_iface new_iface new_details
 
  	    -------------------
  	    -- COMPLETE CODE GENERATION
@@ -243,7 +243,7 @@ hscRecomp ghci_mode dflags location maybe_checked_iface hst hit pcs_ch
 
 
 
-mkFinalIface dflags location maybe_old_iface new_iface new_details
+mkFinalIface ghci_mode dflags location maybe_old_iface new_iface new_details
  = case completeIface maybe_old_iface new_iface new_details of
       (new_iface, Nothing) -- no change in the interfacfe
          -> do when (dopt Opt_D_dump_hi_diffs dflags)
@@ -252,10 +252,14 @@ mkFinalIface dflags location maybe_old_iface new_iface new_details
                              "UNCHANGED FINAL INTERFACE" (pprIface new_iface)
 	       return new_iface
       (new_iface, Just sdoc_diffs)
-         -> do dumpIfSet_dyn dflags Opt_D_dump_hi_diffs "INTERFACE HAS CHANGED" sdoc_diffs
-               dumpIfSet_dyn dflags Opt_D_dump_hi "NEW FINAL INTERFACE" (pprIface new_iface)
+         -> do dumpIfSet_dyn dflags Opt_D_dump_hi_diffs "INTERFACE HAS CHANGED" 
+                                    sdoc_diffs
+               dumpIfSet_dyn dflags Opt_D_dump_hi "NEW FINAL INTERFACE" 
+                                    (pprIface new_iface)
                -- Write the interface file
-               writeIface (unJust (ml_hi_file location) "hscRecomp:hi") new_iface
+               when (ghci_mode /= Interactive) 
+                    (writeIface (unJust "hscRecomp:hi" (ml_hi_file location))
+                                new_iface)
                return new_iface
 
 

ghc/compiler/utils/Util.lhs

@@ -138,9 +138,9 @@ nTimes n f = f . nTimes (n-1) f
 %************************************************************************
 
 \begin{code}
-unJust :: Maybe a -> String -> a
-unJust (Just x) who = x
-unJust Nothing  who = panic ("unJust of Nothing, called by " ++ who)
+unJust :: String -> Maybe a -> a
+unJust who (Just x) = x
+unJust who Nothing  = panic ("unJust of Nothing, called by " ++ who)
 \end{code}
 
 %************************************************************************