@@ -11,45 +11,42 @@ import Control.Applicative
1111import Control.Monad.State
1212import Data.Maybe
1313import Data.List
14+import qualified Data.Set as S
1415
1516findUnusedArgs :: [Name] -> Idris ()
16−findUnusedArgs ns = mapM_ traceUnused ns
17−
18−traceUnused :: Name -> Idris ()
19−traceUnused n = withContext_ idris_callgraph n $
20− \(CGInfo args calls scg usedns _) -> do
21− let argpos = zip args [0..]
22− let fargs = concatMap (getFargpos calls) argpos
23− logLvl 3 $ show n ++ " used TRACE: " ++ show fargs
24− recused <- mapM getUsed fargs
25− let fused = nub $ usedns ++ map fst (filter snd recused)
26− logLvl 1 $ show n ++ " used args: " ++ show fused
27− let unusedpos = mapMaybe (getUnused fused) (zip [0..] args)
28− logLvl 1 $ show n ++ " unused args: " ++ show (args, unusedpos)
29− addToCG n (CGInfo args calls scg usedns unusedpos) -- updates
17+findUnusedArgs = mapM_ (\n -> withContext_ idris_callgraph n $ traceUnused n)
18+
19+traceUnused :: Name -> CGInfo -> Idris ()
20+traceUnused n (CGInfo args calls scg usedns _) = do
21+ logLvl 3 $ show n ++ " used TRACE: " ++ show fargs
22+ recused <- recUsed . idris_callgraph <$> getIState
23+ let fused = nub $ usedns ++ recused
24+ logLvl 1 $ show n ++ " used args: " ++ show fused
25+ let unused = findIndices (not . (`elem` fused)) args
26+ logLvl 1 $ show n ++ " unused args: " ++ show (args, unused)
27+ addToCG n (CGInfo args calls scg usedns unused) -- updates
3028 where
31− getUsed (argn, i, (g, j)) = (,) argn <$> used [(n,i)] g j
32− getUnused fused (i,n)
33− | n `elem` fused = Nothing
34− | otherwise = Just i
35−
36−used :: [(Name, Int)] -> Name -> Int -> Idris Bool
37−used path g j
38− | (g, j) `elem` path = return False -- cycle, never used on the way
39− | otherwise = withContext idris_callgraph g True $
40− \(CGInfo args calls scg usedns unused) ->
29+ fargs = concatMap (getFargpos calls) (zip args [0..])
30+ recUsed cg = [n | (n, i, (g,j)) <- fargs, used cg [(n,i)] g j]
31+
32+used :: Ctxt CGInfo -> [(Name, Int)] -> Name -> Int -> Bool
33+used cg path g j
34+ | (g, j) `elem` path = False -- cycle, never used on the way
35+ | otherwise = case lookupCtxt g cg of
36+ [CGInfo args calls scg usedns unused] ->
4137 if j >= length args
42− then return True -- overapplied, assume used
43− else do
44− logLvl 5 $ (show ((g, j) : path))
45− let directuse = args!!j `elem` usedns
46− let garg = getFargpos calls (args!!j, j)
47− logLvl 5 $ show (g, j, garg)
48− recused <- mapM getUsed garg
38+ then True -- overapplied, assume used
39+ else
40+ --logLvl 5 $ (show ((g, j) : path))
41+ let directuse = args!!j `elem` usedns in
42+ let garg = getFargpos calls (args!!j, j) in
43+ --logLvl 5 $ show (g, j, garg)
44+ let recused = map getUsed garg in
4945 -- used on any route from here, or not used recursively
50− return (directuse || null recused || or recused)
46+ (directuse || null recused || or recused)
47+ _ -> True
5148 where
52− getUsed (argn, j, (g', j')) = used ((g,j):path) g' j'
49+ getUsed (argn, j, (g', j')) = used cg ((g,j):path) g' j'
5350
5451getFargpos :: [(Name, [[Name]])] -> (Name, Int) -> [(Name, Int, (Name, Int))]
5552getFargpos calls (n, i) = concatMap (getCallArgpos n i) calls