git.iko.soy/Idris-dev
on master help sign in
Don't analyse programs without main.
3521b16Matus Tejiscak
src/Idris/Erasure.hs+19−13
compare with master
unifiedsplit
@@ -53,24 +53,30 @@ type Vars = Map Name Var
53performUsageAnalysis :: Idris [Name]
53performUsageAnalysis :: Idris [Name]
54performUsageAnalysis = do
54performUsageAnalysis = do
55 ctx <- tt_ctxt <$> getIState
55 ctx <- tt_ctxt <$> getIState
56− ci <- idris_classes <$> getIState
57
56
58− -- Build the dependency graph.
57+ case lookupCtxt mainName (definitions ctx) of
59− let depMap = buildDepMap ci ctx (sNS (sUN "main") ["Main"])
58+ [] -> return [] -- no main -> not compiling -> reachability irrelevant
59+ _ -> do
60+ ci <- idris_classes <$> getIState
60
61
61− -- Search for reachable nodes in the graph.
62+ -- Build the dependency graph.
62− let (residDeps, (reachableNames, minUse)) = minimalUsage depMap
63+ let depMap = buildDepMap ci ctx mainName
63
64
64− -- Print some debug info.
65+ -- Search for reachable nodes in the graph.
65− logLvl 3 $ "Reachable names:\n" ++ unlines (map show . S.toList $ reachableNames)
66+ let (residDeps, (reachableNames, minUse)) = minimalUsage depMap
66− logLvl 4 $ "Minimal usage:\n" ++ fmtUseMap minUse
67− logLvl 5 $ "Residual deps:\n" ++ unlines (map fmtItem . M.toList $ residDeps)
68
67
69− -- Store the usage info in the internal state.
68+ -- Print some debug info.
70− mapM_ storeUsage . M.toList $ minUse
69+ logLvl 3 $ "Reachable names:\n" ++ unlines (map show . S.toList $ reachableNames)
70+ logLvl 4 $ "Minimal usage:\n" ++ fmtUseMap minUse
71+ logLvl 5 $ "Residual deps:\n" ++ unlines (map fmtItem . M.toList $ residDeps)
71
72
73+ -- Store the usage info in the internal state.
74+ mapM_ storeUsage . M.toList $ minUse
75+
72− return $ S.toList reachableNames
76+ return $ S.toList reachableNames
73 where
77 where
78+ mainName = sNS (sUN "main") ["Main"]
79+
74 fmtItem :: (Cond, Set Node) -> String
80 fmtItem :: (Cond, Set Node) -> String
75 fmtItem (cond, deps) = show (S.toList cond) ++ " -> " ++ show (S.toList deps)
81 fmtItem (cond, deps) = show (S.toList cond) ++ " -> " ++ show (S.toList deps)
76
82
@@ -109,7 +115,7 @@ forwardChain deps
109-- Build the dependency graph,
115-- Build the dependency graph,
110-- starting the depth-first search from a list of Names.
116-- starting the depth-first search from a list of Names.
111buildDepMap :: Ctxt ClassInfo -> Context -> Name -> Deps
117buildDepMap :: Ctxt ClassInfo -> Context -> Name -> Deps
112−buildDepMap ci ctx rootName = addPostulates $ dfs S.empty M.empty [rootName]
118+buildDepMap ci ctx mainName = addPostulates $ dfs S.empty M.empty [mainName]
113 where
119 where
114 -- mark the result of Main.main as used with the empty assumption
120 -- mark the result of Main.main as used with the empty assumption
115 addPostulates :: Deps -> Deps
121 addPostulates :: Deps -> Deps