A couple more small refactorings
authorIan Lynagh <ian@well-typed.com>
Thu, 7 Mar 2013 20:21:09 +0000 (20:21 +0000)
committerIan Lynagh <ian@well-typed.com>
Sat, 9 Mar 2013 15:39:24 +0000 (15:39 +0000)
compiler/main/DriverPipeline.hs
compiler/main/HscMain.hs

index f2fba96..5bd0694 100644 (file)
@@ -189,7 +189,7 @@ compileOne' m_tc_result mHscMessage
                    _ -> do guts0 <- hscDesugar hsc_env' summary tc_result
                            guts <- hscSimplify hsc_env' guts0
                            (iface, _changed, details, cgguts) <- hscNormalIface hsc_env' guts mb_old_hash
-                           HscRecomp hasStub (comp_bc, modBreaks) <- hscInteractive hsc_env' cgguts summary
+                           (hasStub, comp_bc, modBreaks) <- hscInteractive hsc_env' cgguts summary
 
                            stub_o <- case hasStub of
                                      Nothing -> return []
@@ -1027,31 +1027,29 @@ runPhase (Hsc src_flavour) input_fn dflags0
                                mod_summary source_unchanged
 
         case result of
-          Nothing
-              -> do liftIO $ touchObjectFile dflags' o_file
-                    -- The .o file must have a later modification date
-                    -- than the source file (else we wouldn't get Nothing)
-                    -- but we touch it anyway, to keep 'make' happy (we think).
-                    return (StopLn, o_file)
-          (Just (HscRecomp hasStub mOutputFilename))
-              -> do case hasStub of
-                      Nothing -> return ()
-                      Just stub_c ->
-                          do stub_o <- liftIO $ compileStub hsc_env' stub_c
-                             setStubO stub_o
-                    -- In the case of hs-boot files, generate a dummy .o-boot
-                    -- stamp file for the benefit of Make
-                    outputFilename <-
-                        case mOutputFilename of
-                        Just x -> return x
-                        Nothing ->
-                            if isHsBoot src_flavour
-                            then do liftIO $ touchObjectFile dflags' o_file
-                                    whenGeneratingDynamicToo dflags' $ do
-                                        let dyn_o_file = addBootSuffix (replaceExtension o_file (dynObjectSuf dflags'))
-                                        liftIO $ touchObjectFile dflags' dyn_o_file
-                                    return o_file
-                            else return $ panic "runPhase Hsc: No output filename"
+            HscNotGeneratingCode ->
+                return (next_phase,
+                        panic "No output filename from Hsc when no-code")
+            HscUpToDate ->
+                do liftIO $ touchObjectFile dflags' o_file
+                   -- The .o file must have a later modification date
+                   -- than the source file (else we wouldn't get Nothing)
+                   -- but we touch it anyway, to keep 'make' happy (we think).
+                   return (StopLn, o_file)
+            HscUpdateBoot ->
+                do -- In the case of hs-boot files, generate a dummy .o-boot
+                   -- stamp file for the benefit of Make
+                   liftIO $ touchObjectFile dflags' o_file
+                   whenGeneratingDynamicToo dflags' $ do
+                       let dyn_o_file = addBootSuffix (replaceExtension o_file (dynObjectSuf dflags'))
+                       liftIO $ touchObjectFile dflags' dyn_o_file
+                   return (next_phase, o_file)
+            HscRecomp outputFilename mStub
+              -> do case mStub of
+                        Nothing -> return ()
+                        Just stub_c ->
+                            do stub_o <- liftIO $ compileStub hsc_env' stub_c
+                               setStubO stub_o
 
                     return (next_phase, outputFilename)
 
index 83be1c0..975ff9d 100644 (file)
@@ -525,13 +525,16 @@ This is the only thing that isn't caught by the type-system.
 
 
 -- | Status of a compilation to hard-code
-data HscStatus a
-    = HscRecomp
+data HscStatus
+    = HscNotGeneratingCode
+    | HscUpToDate
+    | HscUpdateBoot
+    | HscRecomp
+          FilePath
           (Maybe FilePath) -- Has stub files. This is a hack. We can't compile
                            -- C files here since it's done in DriverPipeline.
                            -- For now we just return True if we want the caller
                            -- to compile them for us.
-          a
 
 type Messager = HscEnv -> (Int,Int) -> RecompileRequired -> ModSummary -> IO ()
 
@@ -620,7 +623,7 @@ genericHscFrontend mod_summary
 hscCompileOneShot :: HscEnv
                   -> ModSummary
                   -> SourceModified
-                  -> IO (Maybe (HscStatus (Maybe FilePath)))
+                  -> IO HscStatus
 hscCompileOneShot hsc_env mod_summary src_changed
   = do
     -- One-shot mode needs a knot-tying mutable variable for interface
@@ -633,27 +636,27 @@ hscCompileOneShot hsc_env mod_summary src_changed
 
         skip = do msg UpToDate
                   dumpIfaceStats hsc_env'
-                  return Nothing
+                  return HscUpToDate
 
         compile mb_old_hash reason = runHsc hsc_env' $ do
             liftIO $ msg reason
             tc_result <- genericHscFrontend mod_summary
             dflags <- getDynFlags
             case hscTarget dflags of
-                HscNothing -> return (Just (HscRecomp Nothing Nothing))
+                HscNothing -> return HscNotGeneratingCode
                 _ ->
                     case ms_hsc_src mod_summary of
                     HsBootFile ->
                         do (iface, changed, _) <- hscSimpleIface' tc_result mb_old_hash
                            liftIO $ hscWriteIface dflags iface changed mod_summary
-                           return (Just (HscRecomp Nothing Nothing))
+                           return HscUpdateBoot
                     _ ->
                         do guts0 <- hscDesugar' (ms_location mod_summary) tc_result
                            guts <- hscSimplify' guts0
                            (iface, changed, _details, cgguts) <- hscNormalIface' guts mb_old_hash
                            liftIO $ hscWriteIface dflags iface changed mod_summary
-                           (outputFilename, hasStub) <- liftIO $ hscGenHardCode hsc_env' cgguts mod_summary
-                           return (Just (HscRecomp hasStub (Just outputFilename)))
+                           (outputFilename, mStub) <- liftIO $ hscGenHardCode hsc_env' cgguts mod_summary
+                           return $ HscRecomp outputFilename mStub
 
         stable = case src_changed of
                      SourceUnmodifiedAndStable -> True
@@ -1194,7 +1197,7 @@ hscGenHardCode hsc_env cgguts mod_summary = do
 hscInteractive :: HscEnv
                -> CgGuts
                -> ModSummary
-               -> IO (HscStatus (CompiledByteCode, ModBreaks))
+               -> IO (Maybe FilePath, CompiledByteCode, ModBreaks)
 #ifdef GHCI
 hscInteractive hsc_env cgguts mod_summary = do
     let dflags = hsc_dflags hsc_env
@@ -1221,7 +1224,7 @@ hscInteractive hsc_env cgguts mod_summary = do
     ------------------ Create f-x-dynamic C-side stuff ---
     (_istub_h_exists, istub_c_exists)
         <- outputForeignStubs dflags this_mod location foreign_stubs
-    return (HscRecomp istub_c_exists (comp_bc, mod_breaks))
+    return (istub_c_exists, comp_bc, mod_breaks)
 #else
 hscInteractive _ _ = panic "GHC not compiled with interpreter"
 #endif