Fix merge conflicts
[hadrian.git] / src / Oracles / ModuleFiles.hs
1 module Oracles.ModuleFiles (
2 decodeModule, encodeModule, findGenerator, hsSources, hsObjects, moduleFilesOracle
3 ) where
4
5 import qualified Data.HashMap.Strict as Map
6
7 import Base
8 import Context
9 import GHC
10 import Oracles.PackageData
11
12 newtype ModuleFiles = ModuleFiles (Stage, Package)
13 deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
14
15 newtype Generator = Generator (Stage, Package, FilePath)
16 deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
17
18 -- | We scan for the following Haskell source extensions when looking for module
19 -- files. Note, we do not list "*.(l)hs-boot" files here, as they can never
20 -- appear by themselves and always have accompanying "*.(l)hs" master files.
21 haskellExtensions :: [String]
22 haskellExtensions = [".hs", ".lhs"]
23
24 -- | Non-Haskell source extensions and corresponding builders.
25 otherExtensions :: [(String, Builder)]
26 otherExtensions = [ (".x" , Alex )
27 , (".y" , Happy )
28 , (".ly" , Happy )
29 , (".hsc", Hsc2Hs) ]
30
31 -- | We match the following file patterns when looking for module files.
32 moduleFilePatterns :: [FilePattern]
33 moduleFilePatterns = map ("*" ++) $ haskellExtensions ++ map fst otherExtensions
34
35 -- | Given a FilePath determine the corresponding builder.
36 determineBuilder :: FilePath -> Maybe Builder
37 determineBuilder file = lookup (takeExtension file) otherExtensions
38
39 -- | Given a module name extract the directory and file name, e.g.:
40 --
41 -- > decodeModule "Data.Functor.Identity" == ("Data/Functor", "Identity")
42 -- > decodeModule "Prelude" == ("", "Prelude")
43 decodeModule :: String -> (FilePath, String)
44 decodeModule modName = (intercalate "/" (init xs), last xs)
45 where
46 xs = words $ replaceEq '.' ' ' modName
47
48 -- | Given the directory and file name find the corresponding module name, e.g.:
49 --
50 -- > encodeModule "Data/Functor" "Identity.hs" == "Data.Functor.Identity"
51 -- > encodeModule "" "Prelude" == "Prelude"
52 -- > uncurry encodeModule (decodeModule name) == name
53 encodeModule :: FilePath -> String -> String
54 encodeModule dir file
55 | dir == "" = takeBaseName file
56 | otherwise = replaceEq '/' '.' dir ++ '.' : takeBaseName file
57
58 -- | Find the generator for a given 'Context' and a source file. For example:
59 -- findGenerator (Context Stage1 compiler vanilla)
60 -- "_build/stage1/compiler/build/Lexer.hs"
61 -- == Just ("compiler/parser/Lexer.x", Alex)
62 -- findGenerator (Context Stage1 base vanilla)
63 -- "_build/stage1/base/build/Prelude.hs"
64 -- == Nothing
65 findGenerator :: Context -> FilePath -> Action (Maybe (FilePath, Builder))
66 findGenerator Context {..} file = do
67 maybeSource <- askOracle $ Generator (stage, package, file)
68 return $ do
69 source <- maybeSource
70 builder <- determineBuilder source
71 return (source, builder)
72
73 -- | Find all Haskell source files for a given 'Context'.
74 hsSources :: Context -> Action [FilePath]
75 hsSources context = do
76 let modFile (m, Nothing ) = generatedFile context m
77 modFile (m, Just file )
78 | takeExtension file `elem` haskellExtensions = return file
79 | otherwise = generatedFile context m
80 mapM modFile =<< contextFiles context
81
82 -- | Find all Haskell object files for a given 'Context'. Note: this is a much
83 -- simpler function compared to 'hsSources', because all object files live in
84 -- the build directory regardless of whether they are generated or not.
85 hsObjects :: Context -> Action [FilePath]
86 hsObjects context = do
87 path <- buildPath context
88 modules <- pkgDataList (Modules path)
89 -- GHC.Prim module is only for documentation, we do not actually build it.
90 mapM (objectPath context . moduleSource) (filter (/= "GHC.Prim") modules)
91
92 -- | Generated module files live in the 'Context' specific build directory.
93 generatedFile :: Context -> String -> Action FilePath
94 generatedFile context moduleName = do
95 path <- buildPath context
96 return $ path -/- moduleSource moduleName
97
98 moduleSource :: String -> FilePath
99 moduleSource moduleName = replaceEq '.' '/' moduleName <.> "hs"
100
101 -- | Module files for a given 'Context'.
102 contextFiles :: Context -> Action [(String, Maybe FilePath)]
103 contextFiles context@Context {..} = do
104 path <- buildPath context
105 modules <- fmap sort . pkgDataList $ Modules path
106 zip modules <$> askOracle (ModuleFiles (stage, package))
107
108 -- | This is an important oracle whose role is to find and cache module source
109 -- files. It takes a 'Stage' and a 'Package', looks up corresponding source
110 -- directories @dirs@ and a sorted list of module names @modules@, and for each
111 -- module, e.g. @A.B.C@, returns a 'FilePath' of the form @dir/A/B/C.extension@,
112 -- such that @dir@ belongs to @dirs@, and file @dir/A/B/C.extension@ exists, or
113 -- 'Nothing' if there is no such file. If more than one matching file is found
114 -- an error is raised. For example, for 'Stage1' and 'compiler', @dirs@ will
115 -- contain ["compiler/codeGen", "compiler/parser"], and @modules@ will contain
116 -- ["CodeGen.Platform.ARM", "Config", "Lexer"]; the oracle will produce a list
117 -- containing [Just "compiler/codeGen/CodeGen/Platform/ARM.hs", Nothing,
118 -- Just "compiler/parser/Lexer.x"]. The oracle ignores @.(l)hs-boot@ files.
119 moduleFilesOracle :: Rules ()
120 moduleFilesOracle = void $ do
121 void . addOracle $ \(ModuleFiles (stage, package)) -> do
122 let context = vanillaContext stage package
123 path <- buildPath context
124 srcDirs <- pkgDataList $ SrcDirs path
125 modules <- fmap sort . pkgDataList $ Modules path
126 autogen <- autogenPath context
127 let dirs = autogen : map (pkgPath package -/-) srcDirs
128 modDirFiles = groupSort $ map decodeModule modules
129 result <- concatForM dirs $ \dir -> do
130 todo <- filterM (doesDirectoryExist . (dir -/-) . fst) modDirFiles
131 forM todo $ \(mDir, mFiles) -> do
132 let fullDir = unifyPath $ dir -/- mDir
133 files <- getDirectoryFiles fullDir moduleFilePatterns
134 let cmp fe f = compare (dropExtension fe) f
135 found = intersectOrd cmp files mFiles
136 return (map (fullDir -/-) found, mDir)
137 let pairs = sort [ (encodeModule d f, f) | (fs, d) <- result, f <- fs ]
138 multi = [ (m, f1, f2) | (m, f1):(n, f2):_ <- tails pairs, m == n ]
139 unless (null multi) $ do
140 let (m, f1, f2) = head multi
141 error $ "Module " ++ m ++ " has more than one source file: "
142 ++ f1 ++ " and " ++ f2 ++ "."
143 return $ lookupAll modules pairs
144
145 -- Optimisation: we discard Haskell files here, because they are never used
146 -- as generators, and hence would be discarded in 'findGenerator' anyway.
147 generators <- newCache $ \(stage, package) -> do
148 let context = vanillaContext stage package
149 files <- contextFiles context
150 list <- sequence [ (,src) <$> (generatedFile context modName)
151 | (modName, Just src) <- files
152 , takeExtension src `notElem` haskellExtensions ]
153 return $ Map.fromList list
154
155 addOracle $ \(Generator (stage, package, file)) ->
156 Map.lookup file <$> generators (stage, package)