#include "HsVersions.h"
import List ( nub )
-import Maybe ( catMaybes, maybeToList, fromMaybe )
+import Maybe ( catMaybes, fromMaybe )
import Maybes ( maybeToBool )
import Outputable
import UniqFM ( emptyUFM, lookupUFM, addToUFM, delListFromUFM,
UniqFM, listToUFM )
import Unique ( Uniquable )
-import Digraph ( SCC(..), stronglyConnComp, flattenSCC, flattenSCCs )
+import Digraph ( SCC(..), stronglyConnComp )
import CmLink
import CmTypes
import HscTypes
import Interpreter ( HValue )
-import Module ( ModuleName, moduleName, packageOfModule,
- isModuleInThisPackage, PackageName, moduleEnvElts,
+import Module ( ModuleName, moduleName,
+ isModuleInThisPackage, moduleEnvElts,
moduleNameUserString )
-import CmStaticInfo ( Package(..), PackageConfigInfo, GhciMode(..) )
+import CmStaticInfo ( PackageConfigInfo, GhciMode(..) )
import DriverPipeline
import GetImports
import HscTypes ( HomeSymbolTable, HomeIfaceTable,
import PrelNames ( mainName )
import HscMain ( initPersistentCompilerState )
import Finder ( findModule, emptyHomeDirCache )
-import DriverUtil ( BarfKind(..) )
+import DriverUtil ( BarfKind(..), splitFilename3 )
import Util
import Panic ( panic )
| trace ("getSummary: "++ showSDoc (ppr nm)) True
= do found <- findModule nm
case found of
+ -- Be sure not to use the mod and location passed in to
+ -- summarise for any other purpose -- summarise may change
+ -- the module names in them if name of module /= name of file,
+ -- and put the changed versions in the returned summary.
+ -- These will then conflict with the passed-in versions.
Just (mod, location) -> summarise mod location
Nothing -> throwDyn (OtherError
("no signs of life for module `"
else loop (newHomeSummaries ++ homeSummaries)
--- Summarise a module, and pick and source and interface timestamps.
+-- Summarise a module, and pick up source and interface timestamps.
summarise :: Module -> ModuleLocation -> IO ModSummary
summarise mod location
| isModuleInThisPackage mod
= do let hs_fn = unJust (ml_hs_file location) "summarise"
hspp_fn <- preprocess hs_fn
modsrc <- readFile hspp_fn
- let (srcimps,imps) = getImports modsrc
+ let (srcimps,imps,mod_name) = getImports modsrc
maybe_src_timestamp
<- case ml_hs_file location of
Nothing -> return Nothing
Just if_fn -> maybe_getModificationTime if_fn
- return (ModSummary mod location{ml_hspp_file=Just hspp_fn}
- srcimps imps
- maybe_src_timestamp maybe_iface_timestamp)
+ -- If the module name is Main, allow it to be in a file
+ -- different from Main.hs, and mash the mod and loc
+ -- to match. Otherwise just moan.
+ (mashed_mod, mashed_loc)
+ <- case () of
+ () | mod_name == moduleName mod
+ -> return (mod, location)
+ | mod_name /= moduleName mod && mod_name == mkModuleName "Main"
+ -> return (mash mod location "Main")
+ | otherwise
+ -> do hPutStrLn stderr (showSDoc (
+ text "ghc: warning: file name - module name mismatch:" <+>
+ ppr (moduleName mod) <+> text "vs" <+> ppr mod_name))
+ return (mash mod location (moduleNameUserString (moduleName mod)))
+ where
+ mash old_mod old_loc new_nm
+ = (mkHomeModule (mkModuleName new_nm),
+ old_loc{ml_hi_file = maybe_swizzle_basename new_nm
+ (ml_hi_file old_loc)})
+
+ maybe_swizzle_basename new Nothing = Nothing
+ maybe_swizzle_basename new (Just old)
+ = case splitFilename3 old of
+ (dir, name, ext) -> Just (dir ++ new ++ ext)
+
+ return (ModSummary mashed_mod
+ mashed_loc{ml_hspp_file=Just hspp_fn}
+ srcimps imps
+ maybe_src_timestamp maybe_iface_timestamp)
+
| otherwise
= return (ModSummary mod location [] [] Nothing Nothing)
-----------------------------------------------------------------------------
--- $Id: GetImports.hs,v 1.1 2000/11/16 15:57:05 simonmar Exp $
+-- $Id: GetImports.hs,v 1.2 2000/11/17 13:33:17 sewardj Exp $
--
-- GHC Driver program
--
import List
import Char
-getImports :: String -> ([ModuleName], [ModuleName])
-getImports str
- = let all_imps = (nub . gmiBase . clean) str
- srcs = concatMap (either unit nil) all_imps
- normals = concatMap (either nil unit) all_imps
- unit x = [x]
- nil x = []
- in (srcs, normals)
-
--- really get the imports from a de-litted, cpp'd, de-literal'd string
--- Lefts are source imports. Rights are normal ones.
-gmiBase :: String -> [Either ModuleName ModuleName]
-gmiBase s
- = f (words s)
+getImports :: String -> ([ModuleName], [ModuleName], ModuleName)
+getImports s
+ = f [{-accum source imports-}] [{-accum normal imports-}]
+ (mkModuleName "Main") (words (clean s))
where
- f ("foreign" : "import" : ws) = f ws
- f ("import" : "{-#" : "SOURCE" : "#-}" : "qualified" : m : ws)
- = Left (mkMN m) : f ws
- f ("import" : "{-#" : "SOURCE" : "#-}" : m : ws)
- = Left (mkMN m) : f ws
- f ("import" : "qualified" : m : ws)
- = Right (mkMN m) : f ws
- f ("import" : m : ws)
- = Right (mkMN m) : f ws
- f (w:ws) = f ws
- f [] = []
+ f si ni _ ("module" : me : ws) = f si ni (mkModuleName me) ws
+
+ f si ni me ("foreign" : "import" : ws) = f si ni me ws
+ f si ni me ("import" : "{-#" : "SOURCE" : "#-}" : "qualified" : m : ws)
+ = f ((mkMN m):si) ni me ws
+ f si ni me ("import" : "{-#" : "SOURCE" : "#-}" : m : ws)
+ = f ((mkMN m):si) ni me ws
+ f si ni me ("import" : "qualified" : m : ws)
+ = f si ((mkMN m):ni) me ws
+ f si ni me ("import" : m : ws)
+ = f si ((mkMN m):ni) me ws
+ f si ni me (w:ws) = f si ni me ws
+ f si ni me [] = (nub si, nub ni, me)
mkMN str = mkModuleName (takeWhile isModId str)
isModId c = isAlphaNum c || c `elem` "'_"
projects / ghc-hetmet.git / commitdiff