on master help sign in
More purification.
7590fa0Matus Tejiscak
src/Idris/Erasure.hs+18−14
@@ -14,26 +14,30 @@ import Data.List
14import qualified Data.Set as S
14import qualified Data.Set as S
15
15
16findUnusedArgs :: [Name] -> Idris ()
16findUnusedArgs :: [Name] -> Idris ()
17−findUnusedArgs = mapM_ (\n -> withContext_ idris_callgraph n $ traceUnused n)
17+findUnusedArgs names = do
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
18+ cg <- idris_callgraph <$> getIState
23− let fused = nub $ usedns ++ recused
19+ mapM_ (process cg) names
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
28 where
20 where
29− fargs = concatMap (getFargpos calls) (zip args [0..])
21+ process cg n = case lookupCtxt n cg of
30− recUsed cg = [n | (n, i, (g,j)) <- fargs, used cg [(n,i)] g j]
22+ [x] -> do
23+ let unused = traceUnused cg n x
24+ logLvl 1 $ show n ++ " unused: " ++ show unused
25+ addToCG n $ x{ unusedpos = unused }
26+ _ -> return ()
31
27
28+traceUnused :: Ctxt CGInfo -> Name -> CGInfo -> [Int]
29+traceUnused cg n (CGInfo args calls _ usedns _)
30+ = findIndices (not . (`elem` fused)) args
31+ where
32+ fargs = concatMap (getFargpos calls) (zip args [0..])
33+ recused = [n | (n, i, (g,j)) <- fargs, used cg [(n,i)] g j]
34+ fused = nub $ usedns ++ recused
35+
32used :: Ctxt CGInfo -> [(Name, Int)] -> Name -> Int -> Bool
36used :: Ctxt CGInfo -> [(Name, Int)] -> Name -> Int -> Bool
33used cg path g j
37used cg path g j
34 | (g, j) `elem` path = False -- cycle, never used on the way
38 | (g, j) `elem` path = False -- cycle, never used on the way
35 | otherwise = case lookupCtxt g cg of
39 | otherwise = case lookupCtxt g cg of
36− [CGInfo args calls scg usedns unused] ->
40+ [CGInfo args calls _ usedns _] ->
37 if j >= length args
41 if j >= length args
38 then True -- overapplied, assume used
42 then True -- overapplied, assume used
39 else
43 else