git.iko.soy/Idris-dev
on master help sign in
Cached deps added.
06e0bb9Matus Tejiscak
src/IRTS/Compiler.hs+3−1
compare with master
unifiedsplit
@@ -47,12 +47,14 @@ compile codegen f tm
47 defsIn <- mkDecls tm used
47 defsIn <- mkDecls tm used
48 findUnusedArgs used
48 findUnusedArgs used
49
49
50+ -- TODO: traverse all names correctly
51+
50 -- TODO: DEBUG-ONLY, remove
52 -- TODO: DEBUG-ONLY, remove
51 ist <- getIState
53 ist <- getIState
52 let usedF = findUsed (tt_ctxt ist) (idris_callgraph ist) used
54 let usedF = findUsed (tt_ctxt ist) (idris_callgraph ist) used
53 let printCond (ctors, cond) = "if " ++ show (S.toList cond) ++ " -ctors- " ++ show (S.toList ctors)
55 let printCond (ctors, cond) = "if " ++ show (S.toList cond) ++ " -ctors- " ++ show (S.toList ctors)
54 let printDep (i, conds) = unlines . map (" "++) $ (show i : map printCond (S.toList conds))
56 let printDep (i, conds) = unlines . map (" "++) $ (show i : map printCond (S.toList conds))
55− let printItem (fn, deps) = unlines (show fn : map printDep (IM.toList deps))
57+ let printItem (fn, (deps, depns)) = unlines ((show fn ++ " <- " ++ show (S.toList depns)) : map printDep (IM.toList deps))
56 iLOG $ "USAGE ANALYSIS:\n" ++ unlines (map printItem . M.toList $ usedF)
58 iLOG $ "USAGE ANALYSIS:\n" ++ unlines (map printItem . M.toList $ usedF)
57 -- END TODO
59 -- END TODO
58
60
src/Idris/Erasure.hs+24−3
@@ -28,8 +28,13 @@ import Data.IntMap (IntMap)
28-- UseMap maps names to the set of used (reachable) argument positions.
28-- UseMap maps names to the set of used (reachable) argument positions.
29type UseMap = Map Name IntSet
29type UseMap = Map Name IntSet
30
30
31+-- Deps augmented with cached info.
32+-- fst = deps
33+-- snd = all names that the function depends on
34+type Deps' = (Deps, Set Name)
35+
31−-- DepMap maps functions (only functions) to their Deps.
36+-- DepMap maps functions (only functions) to their Deps'.
32−type DepMap = Map Name Deps
37+type DepMap = Map Name Deps'
33
38
34-- Deps of a function is a map from argument index
39-- Deps of a function is a map from argument index
35-- to all usages of the argument, including conditions
40-- to all usages of the argument, including conditions
@@ -54,8 +59,24 @@ type PatVar = Ctors -> Var
54type PatVars = Map Name PatVar
59type PatVars = Map Name PatVar
55
60
56findUsed :: Context -> Ctxt CGInfo -> [Name] -> DepMap
61findUsed :: Context -> Ctxt CGInfo -> [Name] -> DepMap
57−findUsed ctx cg ns = M.fromList [(n, getDeps n) | n <- ns]
62+findUsed ctx cg ns = dfs M.empty ns
58 where
63 where
64+ dfs :: DepMap -> [Name] -> DepMap
65+ dfs dmap [] = dmap
66+ dfs dmap (n : ns)
67+ | n `M.member` dmap = dfs dmap ns
68+ | otherwise = dfs (M.insert n (deps, depn) dmap) ns
69+ where
70+ next = [n | n <- S.toList depn, n `M.notMember` dmap]
71+ depn = depNames deps
72+ deps = getDeps n
73+
74+ depNames :: Deps -> Set Name
75+ depNames = S.unions . map (S.unions . map f . S.toList) . IM.elems
76+ where
77+ f :: (Ctors, Cond) -> Set Name
78+ f (ctors, cond) = S.map fst cond -- let's ignore ctors for now
79+
59 getDeps :: Name -> Deps
80 getDeps :: Name -> Deps
60 getDeps n = case lookupDef n ctx of
81 getDeps n = case lookupDef n ctx of
61 [def] -> getDepsDef def
82 [def] -> getDepsDef def