From a5f9c20a13e80f10a36246f1b4dbdae0f1a93187 Mon Sep 17 00:00:00 2001 From: sewardj Date: Fri, 17 Nov 2000 13:33:17 +0000 Subject: [PATCH 1/1] [project @ 2000-11-17 13:33:17 by sewardj] Facilitate handling the situation where name of module /= name of file. This is handled in CompManager.summarise, which can inspect the source to see what the _real_ module name is, and act accordingly. All a bit messy -- needs a rethink. --- ghc/compiler/compMan/CompManager.lhs | 54 +++++++++++++++++++++++++++------- ghc/compiler/main/DriverPipeline.hs | 4 +-- ghc/compiler/main/DriverUtil.hs | 9 +++++- ghc/compiler/main/GetImports.hs | 44 ++++++++++++--------------- 4 files changed, 71 insertions(+), 40 deletions(-) diff --git a/ghc/compiler/compMan/CompManager.lhs b/ghc/compiler/compMan/CompManager.lhs index b889c86..a653f34 100644 --- a/ghc/compiler/compMan/CompManager.lhs +++ b/ghc/compiler/compMan/CompManager.lhs @@ -14,22 +14,22 @@ where #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, @@ -40,7 +40,7 @@ import Module import PrelNames ( mainName ) import HscMain ( initPersistentCompilerState ) import Finder ( findModule, emptyHomeDirCache ) -import DriverUtil ( BarfKind(..) ) +import DriverUtil ( BarfKind(..), splitFilename3 ) import Util import Panic ( panic ) @@ -534,6 +534,11 @@ downsweep rootNm | 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 `" @@ -557,14 +562,14 @@ downsweep rootNm 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 @@ -575,9 +580,36 @@ summarise mod location 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) diff --git a/ghc/compiler/main/DriverPipeline.hs b/ghc/compiler/main/DriverPipeline.hs index 47535a6..398d3b6 100644 --- a/ghc/compiler/main/DriverPipeline.hs +++ b/ghc/compiler/main/DriverPipeline.hs @@ -1,5 +1,5 @@ ----------------------------------------------------------------------------- --- $Id: DriverPipeline.hs,v 1.28 2000/11/16 16:23:04 sewardj Exp $ +-- $Id: DriverPipeline.hs,v 1.29 2000/11/17 13:33:17 sewardj Exp $ -- -- GHC Driver -- @@ -339,7 +339,7 @@ run_phase Cpp basename suff input_fn output_fn run_phase MkDependHS basename suff input_fn _output_fn = do src <- readFile input_fn - let (import_sources, import_normals) = getImports src + let (import_sources, import_normals, module_name) = getImports src deps_sources <- mapM (findDependency True basename) import_sources deps_normals <- mapM (findDependency False basename) import_normals diff --git a/ghc/compiler/main/DriverUtil.hs b/ghc/compiler/main/DriverUtil.hs index 7d6e6eb..a8dd667 100644 --- a/ghc/compiler/main/DriverUtil.hs +++ b/ghc/compiler/main/DriverUtil.hs @@ -1,5 +1,5 @@ ----------------------------------------------------------------------------- --- $Id: DriverUtil.hs,v 1.7 2000/11/16 11:39:37 simonmar Exp $ +-- $Id: DriverUtil.hs,v 1.8 2000/11/17 13:33:17 sewardj Exp $ -- -- Utils for the driver -- @@ -136,6 +136,13 @@ splitFilename f = (reverse (stripDot rev_basename), reverse rev_ext) stripDot ('.':xs) = xs stripDot xs = xs +-- "foo/bar/xyzzy.ext" -> ("foo/bar", "xyzzy", ".ext") +splitFilename3 :: String -> (String,String,String) +splitFilename3 str + = let dir = getdir str + (name, ext) = splitFilename (drop (length dir) str) + in (dir, name, ext) + remove_suffix :: Char -> String -> String remove_suffix c s | null pre = reverse suf diff --git a/ghc/compiler/main/GetImports.hs b/ghc/compiler/main/GetImports.hs index deeef72..b3a3416 100644 --- a/ghc/compiler/main/GetImports.hs +++ b/ghc/compiler/main/GetImports.hs @@ -1,5 +1,5 @@ ----------------------------------------------------------------------------- --- $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 -- @@ -13,32 +13,24 @@ import Module 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` "'_" -- 1.7.10.4