[commit: ghc] master: Export some useful GHC API functions. (5bb7fec)

git at git.haskell.org git at git.haskell.org
Tue Dec 29 13:12:49 UTC 2015


Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/5bb7fecb09f828ea41e5b5a295ea159fa405dcc5/ghc

>---------------------------------------------------------------

commit 5bb7fecb09f828ea41e5b5a295ea159fa405dcc5
Author: Edward Z. Yang <ezyang at cs.stanford.edu>
Date:   Tue Dec 29 13:43:02 2015 +0100

    Export some useful GHC API functions.
    
    Working on some code using the GHC API, I found these
    functions were useful and wished they were exported.  This
    commit exports them.
    
    Signed-off-by: Edward Z. Yang <ezyang at cs.stanford.edu>
    
    Test Plan: validate
    
    Reviewers: austin, bgamari
    
    Reviewed By: bgamari
    
    Subscribers: hvr, thomie
    
    Differential Revision: https://phabricator.haskell.org/D1710


>---------------------------------------------------------------

5bb7fecb09f828ea41e5b5a295ea159fa405dcc5
 compiler/main/DriverPhases.hs   | 20 ++++++++++++++++++++
 compiler/main/DriverPipeline.hs | 20 +++++++++++++++++++-
 compiler/main/Finder.hs         |  2 ++
 compiler/main/GhcMake.hs        |  8 ++++++++
 ghc/Main.hs                     |  8 +-------
 5 files changed, 50 insertions(+), 8 deletions(-)

diff --git a/compiler/main/DriverPhases.hs b/compiler/main/DriverPhases.hs
index ff6f8b8..84eee1b 100644
--- a/compiler/main/DriverPhases.hs
+++ b/compiler/main/DriverPhases.hs
@@ -25,6 +25,8 @@ module DriverPhases (
    isHaskellSigSuffix,
    isSourceSuffix,
 
+   isHaskellishTarget,
+
    isHaskellishFilename,
    isHaskellSrcFilename,
    isHaskellSigFilename,
@@ -42,6 +44,7 @@ import Outputable
 import Platform
 import System.FilePath
 import Binary
+import Util
 
 -----------------------------------------------------------------------------
 -- Phases
@@ -333,6 +336,23 @@ isDynLibSuffix platform s = s `elem` dynlib_suffixes platform
 isSourceSuffix :: String -> Bool
 isSourceSuffix suff  = isHaskellishSuffix suff || isCishSuffix suff
 
+-- | When we are given files (modified by -x arguments) we need
+-- to determine if they are Haskellish or not to figure out
+-- how we should try to compile it.  The rules are:
+--
+--      1. If no -x flag was specified, we check to see if
+--         the file looks like a module name, has no extension,
+--         or has a Haskell source extension.
+--
+--      2. If an -x flag was specified, we just make sure the
+--         specified suffix is a Haskell one.
+isHaskellishTarget :: (String, Maybe Phase) -> Bool
+isHaskellishTarget (f,Nothing) =
+  looksLikeModuleName f || isHaskellSrcFilename f || '.' `notElem` f
+isHaskellishTarget (_,Just phase) =
+  phase `notElem` [ As True, As False, Cc, Cobjc, Cobjcxx, CmmCpp, Cmm
+                  , StopLn]
+
 isHaskellishFilename, isHaskellSrcFilename, isCishFilename,
     isHaskellUserSrcFilename, isSourceFilename, isHaskellSigFilename
  :: FilePath -> Bool
diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs
index ee07d54..4936ace 100644
--- a/compiler/main/DriverPipeline.hs
+++ b/compiler/main/DriverPipeline.hs
@@ -25,7 +25,7 @@ module DriverPipeline (
 
         -- Exports for hooks to override runPhase and link
    PhasePlus(..), CompPipeline(..), PipeEnv(..), PipeState(..),
-   phaseOutputFilename, getPipeState, getPipeEnv,
+   phaseOutputFilename, getOutputFilename, getPipeState, getPipeEnv,
    hscPostBackendPhase, getLocation, setModLocation, setDynFlags,
    runPhase, exeFileName,
    mkExtraObjToLinkIntoBinary, mkNoteObjsToLinkIntoBinary,
@@ -708,6 +708,9 @@ runHookedPhase pp input dflags =
 -- output.  All the logic about which filenames we generate output
 -- into is embodied in the following function.
 
+-- | Computes the next output filename after we run @next_phase at .
+-- Like 'getOutputFilename', but it operates in the 'CompPipeline' monad
+-- (which specifies all of the ambient information.)
 phaseOutputFilename :: Phase{-next phase-} -> CompPipeline FilePath
 phaseOutputFilename next_phase = do
   PipeEnv{stop_phase, src_basename, output_spec} <- getPipeEnv
@@ -716,6 +719,21 @@ phaseOutputFilename next_phase = do
   liftIO $ getOutputFilename stop_phase output_spec
                              src_basename dflags next_phase maybe_loc
 
+-- | Computes the next output filename for something in the compilation
+-- pipeline.  This is controlled by several variables:
+--
+--      1. 'Phase': the last phase to be run (e.g. 'stopPhase').  This
+--         is used to tell if we're in the last phase or not, because
+--         in that case flags like @-o@ may be important.
+--      2. 'PipelineOutput': is this intended to be a 'Temporary' or
+--         'Persistent' build output?  Temporary files just go in
+--         a fresh temporary name.
+--      3. 'String': what was the basename of the original input file?
+--      4. 'DynFlags': the obvious thing
+--      5. 'Phase': the phase we want to determine the output filename of.
+--      6. @Maybe ModLocation@: the 'ModLocation' of the module we're
+--         compiling; this can be used to override the default output
+--         of an object file.  (TODO: do we actually need this?)
 getOutputFilename
   :: Phase -> PipelineOutput -> String
   -> DynFlags -> Phase{-next phase-} -> Maybe ModLocation -> IO FilePath
diff --git a/compiler/main/Finder.hs b/compiler/main/Finder.hs
index dddc09a..2ac0737 100644
--- a/compiler/main/Finder.hs
+++ b/compiler/main/Finder.hs
@@ -17,6 +17,8 @@ module Finder (
     mkHomeModLocation,
     mkHomeModLocation2,
     mkHiOnlyModLocation,
+    mkHiPath,
+    mkObjPath,
     addHomeModuleToFinder,
     uncacheModule,
     mkStubPaths,
diff --git a/compiler/main/GhcMake.hs b/compiler/main/GhcMake.hs
index 843def1..9c6abb8 100644
--- a/compiler/main/GhcMake.hs
+++ b/compiler/main/GhcMake.hs
@@ -18,6 +18,8 @@ module GhcMake(
 
         topSortModuleGraph,
 
+        ms_home_srcimps, ms_home_imps,
+
         noModError, cyclicModuleErr
     ) where
 
@@ -1709,9 +1711,15 @@ home_imps imps = [ lmodname |  (mb_pkg, lmodname) <- imps,
 ms_home_allimps :: ModSummary -> [ModuleName]
 ms_home_allimps ms = map unLoc (ms_home_srcimps ms ++ ms_home_imps ms)
 
+-- | Like 'ms_home_imps', but for SOURCE imports.
 ms_home_srcimps :: ModSummary -> [Located ModuleName]
 ms_home_srcimps = home_imps . ms_srcimps
 
+-- | All of the (possibly) home module imports from a
+-- 'ModSummary'; that is to say, each of these module names
+-- could be a home import if an appropriately named file
+-- existed.  (This is in contrast to package qualified
+-- imports, which are guaranteed not to be home imports.)
 ms_home_imps :: ModSummary -> [Located ModuleName]
 ms_home_imps = home_imps . ms_imps
 
diff --git a/ghc/Main.hs b/ghc/Main.hs
index 31a9b91..73552d3 100644
--- a/ghc/Main.hs
+++ b/ghc/Main.hs
@@ -694,13 +694,7 @@ addFlag s flag = liftEwM $ do
 
 doMake :: [(String,Maybe Phase)] -> Ghc ()
 doMake srcs  = do
-    let (hs_srcs, non_hs_srcs) = partition haskellish srcs
-
-        haskellish (f,Nothing) =
-          looksLikeModuleName f || isHaskellSrcFilename f || '.' `notElem` f
-        haskellish (_,Just phase) =
-          phase `notElem` [ As True, As False, Cc, Cobjc, Cobjcxx, CmmCpp, Cmm
-                          , StopLn]
+    let (hs_srcs, non_hs_srcs) = partition isHaskellishTarget srcs
 
     hsc_env <- GHC.getSession
 



More information about the ghc-commits mailing list