[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