d4562c4 · Idris-dev · git.iko.soy

git.iko.soy/Idris-dev

on master help sign in

Remove the old findUnusedArgs.

d4562c4Matus Tejiscak13 years ago

src/IRTS/Compiler.hs−2

compare with master

unifiedsplit

@@ -48,7 +48,6 @@ compile codegen f tm

48 usedIn <- mapM (allNames []) tmnames

49 let used = sUN "prim__subBigInt" : sUN "prim__addBigInt" : concat usedIn

50 defsIn <- mkDecls tm used

51− findUnusedArgs used

53 -- TODO: traverse all names correctly

52 -- TODO: traverse all names correctly

@@ -134,7 +133,6 @@ mkDecls :: Term -> [Name] -> Idris [(Name, LDecl)]

134mkDecls t used

133mkDecls t used

135 = do i <- getIState

134 = do i <- getIState

136 let ds = filter (\ (n, d) -> n `elem` used || isCon d) $ ctxtAlist (tt_ctxt i)

135 let ds = filter (\ (n, d) -> n `elem` used || isCon d) $ ctxtAlist (tt_ctxt i)

137− findUnusedArgs used

138 decls <- mapM build ds

136 decls <- mapM build ds

139 return decls

137 return decls

140

138

src/Idris/Erasure.hs+2−51

@@ -1,8 +1,7 @@

1{-# LANGUAGE PatternGuards #-}

3module Idris.Erasure

4− ( findUnusedArgs

5− , buildDepMap

4+ ( buildDepMap

6 , minimalUsage

5 , minimalUsage

7 ) where

6 ) where

@@ -97,6 +96,7 @@ buildDepMap ctx ns = addPostulates $ dfs S.empty M.empty ns

97 , (name "prim__concat", Arg 0)

96 , (name "prim__concat", Arg 0)

98 , (name "prim__concat", Arg 1)

97 , (name "prim__concat", Arg 1)

99 , (name "mkForeignPrim", Arg 2)

98 , (name "mkForeignPrim", Arg 2)

99+ , (name "mkForeign", Arg 1)

100 ]

101 ]

102

@@ -241,52 +241,3 @@ buildDepMap ctx ns = addPostulates $ dfs S.empty M.empty ns

241

242 unionMap :: (a -> Deps) -> [a] -> Deps

243 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−

src/Idris/REPL.hs+1−1

@@ -655,7 +655,7 @@ process h fn (DebugInfo n)

655 let d = lookupDef n (tt_ctxt i)

656 when (not (null d)) $ iputStrLn $ "Definition: " ++ (show (head d))

657 let cg = lookupCtxtName n (idris_callgraph i)

658− findUnusedArgs (map fst cg)

658+ -- findUnusedArgs (map fst cg) -- TODO: fix this here, do we need this info?

659 i <- getIState

660 let cg' = lookupCtxtName n (idris_callgraph i)

661 sc <- checkSizeChange n