ad0dce1 · Idris-dev · git.iko.soy

git.iko.soy/Idris-dev

Invert the meaning of used/unused in CGInfo.

commitad0dce16fcdfc0fd4f07aca5815e1e50276b5c8a authorMatus Tejiscak <ziman@functor.sk> dateTue 28 Jan 2014, 14:20 (13 years ago) parentf0d7876

3 files changed+15−34

compare with master

unifiedsplit

src/IRTS/Compiler.hs+8−11 src/Idris/AbsSyntaxTree.hs+1−1 src/Idris/Erasure.hs+6−22

src/IRTS/Compiler.hs+8−11

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

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

6161 let minUse = minimalUsage depMap

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

63−

64− let unusedMap = usedToUnused ctx minUse

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

6663 -- END TODO

6764

6865 maindef <- irMain tm

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

258255 (idris_optimisation i) of

259256 Just oi -> collapsible oi

260257 _ -> False

261− let unused

258+ let used

262259 = case lookupCtxtExact n

263260 (idris_callgraph i) of

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

265− unusedpos

266− _ -> []

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

262+ usedpos

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

267264 if collapse

268265 then return LNothing

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

270− (mkUnused unused 0 args'))

267+ (mkUsed used 0 args'))

271268 | (f, args) <- unApply tm

272269 = do f' <- ir' env f

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

274271 return (LApp False f' args')

275− where mkUnused u i [] = []

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

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

272+ where mkUsed u i [] = []

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

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

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

279276-- = return $ LConst (BI 0)

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

src/Idris/AbsSyntaxTree.hs+1−1

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

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

182182 scg :: [SCGEntry],

183183 argsused :: [Name],

184− unusedpos :: [Int] }

184+ usedpos :: [Int] }

185185 deriving Show

186186{-!

187187deriving instance Binary CGInfo

src/Idris/Erasure.hs+6−22

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

44 ( findUnusedArgs

55 , buildDepMap

66 , minimalUsage

7− , usedToUnused

87 ) where

109import Idris.AbsSyntax

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

5049type Var = Set Node

5150type Vars = Map Name Var

5251

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−

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

6953minimalUsage :: Deps -> UseMap

7054minimalUsage = gather . forwardChain

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

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

263247 process cg n = case lookupCtxt n cg of

264248 [x] -> do

265− let unused = traceUnused cg n x

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

267− addToCG n $ x{ unusedpos = unused }

249+ let used = traceUsed cg n x

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

251+ addToCG n $ x{ usedpos = used }

268252 _ -> return ()

269253

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

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

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

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

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

256+ = findIndices (`elem` fused) args

273257 where

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

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