@@ -1,8 +1,7 @@
11{-# LANGUAGE PatternGuards #-}
22
33module Idris.Erasure
4− ( findUnusedArgs
5− , buildDepMap
4+ ( buildDepMap
65 , minimalUsage
76 ) where
87
@@ -97,6 +96,7 @@ buildDepMap ctx ns = addPostulates $ dfs S.empty M.empty ns
9796 , (name "prim__concat", Arg 0)
9897 , (name "prim__concat", Arg 1)
9998 , (name "mkForeignPrim", Arg 2)
99+ , (name "mkForeign", Arg 1)
100100 ]
101101 ]
102102
@@ -241,52 +241,3 @@ buildDepMap ctx ns = addPostulates $ dfs S.empty M.empty ns
241241
242242 unionMap :: (a -> Deps) -> [a] -> Deps
243243 unionMap f = unions . map f
244−
245−findUnusedArgs :: [Name] -> Idris ()
246−findUnusedArgs names = do
247− cg <- idris_callgraph <$> getIState
248− mapM_ (process cg) names
249− where
250− process :: Ctxt CGInfo -> Name -> Idris ()
251− process cg n = case lookupCtxt n cg of
252− [x] -> do
253− let used = traceUsed cg n x
254− logLvl 1 $ show n ++ " used: " ++ show used
255− addToCG n $ x{ usedpos = used }
256− _ -> return ()
257−
258− traceUsed :: Ctxt CGInfo -> Name -> CGInfo -> [Int]
259− traceUsed cg n (CGInfo args calls _ usedns _)
260− = findIndices (`elem` fused) args
261− where
262− fargs = concatMap (getFargpos calls) (zip args [0..])
263− recused = [n | (n, i, (g,j)) <- fargs, used cg [(n,i)] g j]
264− fused = nub $ usedns ++ recused
265−
266− used :: Ctxt CGInfo -> [(Name, Int)] -> Name -> Int -> Bool
267− used cg path g j
268− | (g, j) `elem` path = False -- cycle, never used on the way
269−
270− | [CGInfo args calls _ usedns _] <- lookupCtxt g cg
271− , j < length args -- not overapplied
272− = let directuse = args!!j `elem` usedns
273− garg = getFargpos calls (args!!j, j)
274− recused = map getUsed garg
275− in directuse || or recused
276− -- used on any route from here, or not used recursively
277−
278− | otherwise = True
279− where
280− getUsed (argn, j, (g', j')) = used cg ((g,j):path) g' j'
281−
282− getFargpos :: [(Name, [[Name]])] -> (Name, Int) -> [(Name, Int, (Name, Int))]
283− getFargpos calls (n, i) = concatMap (getCallArgpos n i) calls
284− where
285− getCallArgpos :: Name -> Int -> (Name, [[Name]]) -> [(Name, Int, (Name, Int))]
286− getCallArgpos n i (g, args) = mapMaybe (getOne g) (zip [0..] args)
287−
288− getOne :: Name -> (Int, [Name]) -> Maybe (Name, Int, (Name, Int))
289− getOne g (j, xs)
290− | n `elem` xs = Just (n, i, (g, j))
291− | otherwise = Nothing
292−