4234b0c · rowtype-yoga/purescript-native

git.iko.soy/rowtype-yoga/purescript-native

on golang help sign in

Rebuild modules based on dependencies

4234b0cPhil Freeman13 years ago

src/Language/PureScript.hs+36−16

compare with golang

unifiedsplit

@@ -33,12 +33,15 @@ import Language.PureScript.DeadCodeElimination as P

34import qualified Language.PureScript.Constants as C

36−import Data.List (intercalate)

36+import Data.List (sortBy, groupBy, intercalate)

37import Data.Time.Clock

38+import Data.Function (on)

38import Data.Maybe (fromMaybe, mapMaybe)

39import Data.Maybe (fromMaybe, mapMaybe)

39import Control.Monad.State.Lazy

40import Control.Monad.State.Lazy

41+import Control.Arrow ((&&&))

40import Control.Applicative ((<$>), (<*>), pure)

42import Control.Applicative ((<$>), (<*>), pure)

41import qualified Data.Map as M

43import qualified Data.Map as M

44+import qualified Data.Set as S

42import System.FilePath (pathSeparator)

45import System.FilePath (pathSeparator)

44-- |

47-- |

@@ -65,7 +68,7 @@ compile = compile' initEnvironment

66compile' :: Environment -> Options -> [Module] -> Either String (String, String, Environment)

69compile' :: Environment -> Options -> [Module] -> Either String (String, String, Environment)

67compile' env opts ms = do

70compile' env opts ms = do

68− sorted <- sortModules ms

71+ (sorted, _) <- sortModules ms

69 desugared <- desugar sorted

72 desugared <- desugar sorted

70 (elaborated, env') <- runCheck' env $ forM desugared $ \(Module moduleName' decls exps) -> do

73 (elaborated, env') <- runCheck' env $ forM desugared $ \(Module moduleName' decls exps) -> do

71 modify (\s -> s { checkCurrentModule = Just moduleName' })

74 modify (\s -> s { checkCurrentModule = Just moduleName' })

@@ -126,9 +129,9 @@ make :: (Functor m, Monad m, MonadMake m) => Options -> [(FilePath, Module)] ->

126make opts ms = do

129make opts ms = do

127 let filePathMap = M.fromList (map (\(fp, (Module mn _ _)) -> (mn, fp)) ms)

130 let filePathMap = M.fromList (map (\(fp, (Module mn _ _)) -> (mn, fp)) ms)

128

131

129− sorted <- liftError $ sortModules (map snd ms)

132+ (sorted, graph) <- liftError $ sortModules (map snd ms)

130

133

131− marked <- forM sorted $ \m@(Module moduleName' _ _) -> do

134+ toRebuild <- foldM (\s (Module moduleName' _ _) -> do

132 let filePath = toFileName moduleName'

135 let filePath = toFileName moduleName'

133

136

134 jsFile = "js" ++ pathSeparator : filePath ++ ".js"

137 jsFile = "js" ++ pathSeparator : filePath ++ ".js"

@@ -139,14 +142,11 @@ make opts ms = do

139 externsTimestamp <- getTimestamp externsFile

142 externsTimestamp <- getTimestamp externsFile

140 inputTimestamp <- getTimestamp inputFile

143 inputTimestamp <- getTimestamp inputFile

141

144

142− case inputTimestamp < min jsTimestamp externsTimestamp of

145+ return $ case (inputTimestamp, jsTimestamp, externsTimestamp) of

143− True -> do

146+ (Just t1, Just t2, Just t3) | t1 < min t2 t3 -> s

144− externs <- readTextFile externsFile

147+ _ -> S.insert moduleName' s) S.empty sorted

145− externsModules <- liftError . either (Left . show) Right $ P.runIndentParser externsFile P.parseModules externs

148+

146− case externsModules of

149+ marked <- rebuildIfNecessary (reverseDependencies graph) toRebuild sorted

147− [m'@(Module moduleName'' _ _)] | moduleName' == moduleName'' -> return (True, m')

148− _ -> liftError . Left $ "Externs file " ++ externsFile ++ " was invalid"

149− False -> return (False, m)

150

151 desugared <- liftError $ zip (map fst marked) <$> desugar (map snd marked)

152

@@ -155,13 +155,13 @@ make opts ms = do

155 where

156 go :: (Functor m, Monad m, MonadMake m) => Environment -> [(Bool, Module)] -> m ()

157 go _ [] = return ()

158− go env ((True, Module moduleName' typings _) : ms') = do

158+ go env ((False, Module moduleName' typings _) : ms') = do

159 (_, env') <- liftError . runCheck' env $ do

160 modify (\s -> s { checkCurrentModule = Just moduleName' })

161 typeCheckAll Nothing moduleName' typings

162

163 go env' ms'

164− go env ((False, Module moduleName' decls exps) : ms') = do

164+ go env ((True, Module moduleName' decls exps) : ms') = do

165 let filePath = toFileName moduleName'

166 jsFile = "js" ++ pathSeparator : filePath ++ ".js"

167 externsFile = "externs" ++ pathSeparator : filePath ++ ".externs"

@@ -182,5 +182,25 @@ make opts ms = do

182

183 go env' ms'

184

185− toFileName :: ModuleName -> FilePath

185+toFileName :: ModuleName -> FilePath

186− toFileName (ModuleName ps) = intercalate [pathSeparator] . map runProperName $ ps

186+toFileName (ModuleName ps) = intercalate [pathSeparator] . map runProperName $ ps

187+

188+rebuildIfNecessary :: (Functor m, Monad m, MonadMake m) => M.Map ModuleName [ModuleName] -> S.Set ModuleName -> [Module] -> m [(Bool, Module)]

189+rebuildIfNecessary _ _ [] = return []

190+rebuildIfNecessary graph toRebuild (m@(Module moduleName' _ _) : ms) | moduleName' `S.member` toRebuild = do

191+ let deps = fromMaybe [] $ moduleName' `M.lookup` graph

192+ toRebuild' = toRebuild `S.union` S.fromList deps

193+ (:) (True, m) <$> rebuildIfNecessary graph toRebuild' ms

194+rebuildIfNecessary graph toRebuild (Module moduleName' _ _ : ms) = do

195+ let externsFile = "externs" ++ pathSeparator : toFileName moduleName' ++ ".externs"

196+ externs <- readTextFile externsFile

197+ externsModules <- liftError . either (Left . show) Right $ P.runIndentParser externsFile P.parseModules externs

198+ case externsModules of

199+ [m'@(Module moduleName'' _ _)] | moduleName'' == moduleName' -> (:) (False, m') <$> rebuildIfNecessary graph toRebuild ms

200+ _ -> liftError . Left $ "Externs file " ++ externsFile ++ " was invalid"

201+

202+reverseDependencies :: ModuleGraph -> M.Map ModuleName [ModuleName]

203+reverseDependencies g = combine [ (dep, mn) | (mn, deps) <- g, dep <- deps ]

204+ where

205+ combine :: (Ord a) => [(a, b)] -> M.Map a [b]

206+ combine = M.fromList . map ((fst . head) &&& map snd) . groupBy ((==) `on` fst) . sortBy (compare `on` fst)

src/Language/PureScript/ModuleDependencies.hs+11−3

@@ -13,7 +13,8 @@

13-----------------------------------------------------------------------------

15module Language.PureScript.ModuleDependencies (

16− sortModules

16+ sortModules,

17+ ModuleGraph

17) where

18) where

19import Data.Data

20import Data.Data

@@ -24,15 +25,22 @@ import Data.List (nub)

24import Language.PureScript.Declarations

25import Language.PureScript.Declarations

25import Language.PureScript.Names

26import Language.PureScript.Names

28+-- |

29+-- A list of modules with their dependencies

30+--

31+type ModuleGraph = [(ModuleName, [ModuleName])]

32+

27-- |

33-- |

28-- Sort a collection of modules based on module dependencies.

34-- Sort a collection of modules based on module dependencies.

29--

35--

30-- Reports an error if the module graph contains a cycle.

36-- Reports an error if the module graph contains a cycle.

31--

37--

32−sortModules :: [Module] -> Either String [Module]

38+sortModules :: [Module] -> Either String ([Module], ModuleGraph)

33sortModules ms = do

39sortModules ms = do

34 let verts = map (\m -> (m, getModuleName m, usedModules m)) ms

40 let verts = map (\m -> (m, getModuleName m, usedModules m)) ms

35− mapM toModule $ stronglyConnComp verts

41+ ms' <- mapM toModule $ stronglyConnComp verts

42+ let moduleGraph = map (\(_, mn, deps) -> (mn, deps)) verts

43+ return (ms', moduleGraph)

37-- |

45-- |

38-- Calculate a list of used modules based on explicit imports and qualified names

46-- Calculate a list of used modules based on explicit imports and qualified names