@@ -33,12 +33,15 @@ import Language.PureScript.DeadCodeElimination as P
3333
3434import qualified Language.PureScript.Constants as C
3535
36−import Data.List (intercalate)
36+import Data.List (sortBy, groupBy, intercalate)
3737import Data.Time.Clock
38+import Data.Function (on)
3839import Data.Maybe (fromMaybe, mapMaybe)
3940import Control.Monad.State.Lazy
41+import Control.Arrow ((&&&))
4042import Control.Applicative ((<$>), (<*>), pure)
4143import qualified Data.Map as M
44+import qualified Data.Set as S
4245import System.FilePath (pathSeparator)
4346
4447-- |
@@ -65,7 +68,7 @@ compile = compile' initEnvironment
6568
6669compile' :: Environment -> Options -> [Module] -> Either String (String, String, Environment)
6770compile' env opts ms = do
68− sorted <- sortModules ms
71+ (sorted, _) <- sortModules ms
6972 desugared <- desugar sorted
7073 (elaborated, env') <- runCheck' env $ forM desugared $ \(Module moduleName' decls exps) -> do
7174 modify (\s -> s { checkCurrentModule = Just moduleName' })
@@ -126,9 +129,9 @@ make :: (Functor m, Monad m, MonadMake m) => Options -> [(FilePath, Module)] ->
126129make opts ms = do
127130 let filePathMap = M.fromList (map (\(fp, (Module mn _ _)) -> (mn, fp)) ms)
128131
129− sorted <- liftError $ sortModules (map snd ms)
132+ (sorted, graph) <- liftError $ sortModules (map snd ms)
130133
131− marked <- forM sorted $ \m@(Module moduleName' _ _) -> do
134+ toRebuild <- foldM (\s (Module moduleName' _ _) -> do
132135 let filePath = toFileName moduleName'
133136
134137 jsFile = "js" ++ pathSeparator : filePath ++ ".js"
@@ -139,14 +142,11 @@ make opts ms = do
139142 externsTimestamp <- getTimestamp externsFile
140143 inputTimestamp <- getTimestamp inputFile
141144
142− case inputTimestamp < min jsTimestamp externsTimestamp of
143− True -> do
144− externs <- readTextFile externsFile
145− externsModules <- liftError . either (Left . show) Right $ P.runIndentParser externsFile P.parseModules externs
146− case externsModules of
147− [m'@(Module moduleName'' _ _)] | moduleName' == moduleName'' -> return (True, m')
148− _ -> liftError . Left $ "Externs file " ++ externsFile ++ " was invalid"
149− False -> return (False, m)
145+ return $ case (inputTimestamp, jsTimestamp, externsTimestamp) of
146+ (Just t1, Just t2, Just t3) | t1 < min t2 t3 -> s
147+ _ -> S.insert moduleName' s) S.empty sorted
148+
149+ marked <- rebuildIfNecessary (reverseDependencies graph) toRebuild sorted
150150
151151 desugared <- liftError $ zip (map fst marked) <$> desugar (map snd marked)
152152
@@ -155,13 +155,13 @@ make opts ms = do
155155 where
156156 go :: (Functor m, Monad m, MonadMake m) => Environment -> [(Bool, Module)] -> m ()
157157 go _ [] = return ()
158− go env ((True, Module moduleName' typings _) : ms') = do
158+ go env ((False, Module moduleName' typings _) : ms') = do
159159 (_, env') <- liftError . runCheck' env $ do
160160 modify (\s -> s { checkCurrentModule = Just moduleName' })
161161 typeCheckAll Nothing moduleName' typings
162162
163163 go env' ms'
164− go env ((False, Module moduleName' decls exps) : ms') = do
164+ go env ((True, Module moduleName' decls exps) : ms') = do
165165 let filePath = toFileName moduleName'
166166 jsFile = "js" ++ pathSeparator : filePath ++ ".js"
167167 externsFile = "externs" ++ pathSeparator : filePath ++ ".externs"
@@ -182,5 +182,25 @@ make opts ms = do
182182
183183 go env' ms'
184184
185− toFileName :: ModuleName -> FilePath
186− toFileName (ModuleName ps) = intercalate [pathSeparator] . map runProperName $ ps
185+toFileName :: ModuleName -> FilePath
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)