ad0dce1 · Idris-dev · git.iko.soy

git.iko.soy/Idris-dev

on master help sign in

Invert the meaning of used/unused in CGInfo.

ad0dce1Matus Tejiscak13 years ago

src/IRTS/Compiler.hs+8−11

compare with master

unifiedsplit

@@ -60,9 +60,6 @@ compile codegen f tm

60 let fmtDepMap = unlines . map (\(n,is) -> show n ++ " -> " ++ show (IS.toList is)) . M.toList

61 let minUse = minimalUsage depMap

62 iLOG $ "MINIMAL USAGE:\n" ++ fmtDepMap minUse

63−

64− let unusedMap = usedToUnused ctx minUse

65− iLOG $ "UNUSED:\n" ++ fmtDepMap unusedMap

66 -- END TODO

63 -- END TODO

68 maindef <- irMain tm

65 maindef <- irMain tm

@@ -258,23 +255,23 @@ instance ToIR (TT Name) where

258 (idris_optimisation i) of

255 (idris_optimisation i) of

259 Just oi -> collapsible oi

256 Just oi -> collapsible oi

260 _ -> False

257 _ -> False

261− let unused

258+ let used

262 = case lookupCtxtExact n

259 = case lookupCtxtExact n

263 (idris_callgraph i) of

260 (idris_callgraph i) of

264− Just (CGInfo _ _ _ _ unusedpos) ->

261+ Just (CGInfo _ _ _ _ usedpos) ->

265− unusedpos

262+ usedpos

266− _ -> []

263+ _ -> [] -- TODO: is this correct?

267 if collapse

264 if collapse

268 then return LNothing

265 then return LNothing

269 else return (LApp False (LV (Glob n))

266 else return (LApp False (LV (Glob n))

270− (mkUnused unused 0 args'))

267+ (mkUsed used 0 args'))

271 | (f, args) <- unApply tm

268 | (f, args) <- unApply tm

272 = do f' <- ir' env f

269 = do f' <- ir' env f

273 args' <- mapM (ir' env) args

270 args' <- mapM (ir' env) args

274 return (LApp False f' args')

271 return (LApp False f' args')

275− where mkUnused u i [] = []

272+ where mkUsed u i [] = []

276− mkUnused u i (x : xs) | i `elem` u = LNothing : mkUnused u (i + 1) xs

273+ mkUsed u i (x : xs) | i `notElem` u = LNothing : mkUsed u (i + 1) xs

277− | otherwise = x : mkUnused u (i + 1) xs

274+ | otherwise = x : mkUsed u (i + 1) xs

278-- ir' env (P _ (NS (UN "Z") ["Nat", "Prelude"]) _)

275-- ir' env (P _ (NS (UN "Z") ["Nat", "Prelude"]) _)

279-- = return $ LConst (BI 0)

276-- = return $ LConst (BI 0)

280 ir' env (P _ n _) = return $ LV (Glob n)

277 ir' env (P _ n _) = return $ LV (Glob n)

src/Idris/AbsSyntaxTree.hs+1−1

@@ -181,7 +181,7 @@ data CGInfo = CGInfo { argsdef :: [Name],

181 calls :: [(Name, [[Name]])],

182 scg :: [SCGEntry],

183 argsused :: [Name],

184− unusedpos :: [Int] }

184+ usedpos :: [Int] }

185 deriving Show

186{-!

187deriving instance Binary CGInfo

src/Idris/Erasure.hs+6−22

@@ -4,7 +4,6 @@ module Idris.Erasure

4 ( findUnusedArgs

5 , buildDepMap

6 , minimalUsage

7− , usedToUnused

8 ) where

7 ) where

10import Idris.AbsSyntax

9import Idris.AbsSyntax

@@ -50,21 +49,6 @@ type Cond = Set Node

50type Var = Set Node

49type Var = Set Node

51type Vars = Map Name Var

50type Vars = Map Name Var

53−-- Change the map of used args to a map of unused args.

54−usedToUnused :: Context -> UseMap -> UseMap

55−usedToUnused ctx = M.mapWithKey invert

56− where

57− invert :: Name -> IntSet -> IntSet

58− invert n used = IS.fromList [0 .. arity n - 1] IS.\\ used

59−

60− arity :: Name -> Int

61− arity n = case lookupDef n ctx of

62− [TyDecl (DCon tag n) t] -> n

63− [CaseOp ci ty tys def tot cdefs] -> length tys

64− [def] -> error $ "unsupported definition of " ++ show n ++ ": " ++ show def

65− [] -> error $ "unknown name in conversion to unused: " ++ show n

66− _ -> error $ "ambiguous name in conversion to unused: " ++ show n

67−

68-- Find the minimal consistent usage by forward chaining.

52-- Find the minimal consistent usage by forward chaining.

69minimalUsage :: Deps -> UseMap

53minimalUsage :: Deps -> UseMap

70minimalUsage = gather . forwardChain

54minimalUsage = gather . forwardChain

@@ -262,14 +246,14 @@ findUnusedArgs names = do

262 process :: Ctxt CGInfo -> Name -> Idris ()

246 process :: Ctxt CGInfo -> Name -> Idris ()

263 process cg n = case lookupCtxt n cg of

247 process cg n = case lookupCtxt n cg of

264 [x] -> do

248 [x] -> do

265− let unused = traceUnused cg n x

249+ let used = traceUsed cg n x

266− logLvl 1 $ show n ++ " unused: " ++ show unused

250+ logLvl 1 $ show n ++ " used: " ++ show used

267− addToCG n $ x{ unusedpos = unused }

251+ addToCG n $ x{ usedpos = used }

268 _ -> return ()

252 _ -> return ()

269

253

270− traceUnused :: Ctxt CGInfo -> Name -> CGInfo -> [Int]

254+ traceUsed :: Ctxt CGInfo -> Name -> CGInfo -> [Int]

271− traceUnused cg n (CGInfo args calls _ usedns _)

255+ traceUsed cg n (CGInfo args calls _ usedns _)

272− = findIndices (not . (`elem` fused)) args

256+ = findIndices (`elem` fused) args

273 where

257 where

274 fargs = concatMap (getFargpos calls) (zip args [0..])

258 fargs = concatMap (getFargpos calls) (zip args [0..])

275 recused = [n | (n, i, (g,j)) <- fargs, used cg [(n,i)] g j]

259 recused = [n | (n, i, (g,j)) <- fargs, used cg [(n,i)] g j]