git.iko.soy/Idris-dev
on master help sign in
Add basic conversion to unused-map.
f0d7876Matus Tejiscak
src/IRTS/Compiler.hs+8−3
compare with master
unifiedsplit
@@ -25,6 +25,7 @@ import Idris.Core.TT
25import Idris.Core.Evaluate
25import Idris.Core.Evaluate
26import Idris.Core.CaseTree
26import Idris.Core.CaseTree
27
27
28+import Control.Applicative
28import Control.Monad.State
29import Control.Monad.State
29import Data.List
30import Data.List
30import qualified Data.IntMap as IM
31import qualified Data.IntMap as IM
@@ -51,13 +52,17 @@ compile codegen f tm
51 -- TODO: traverse all names correctly
52 -- TODO: traverse all names correctly
52
53
53 -- TODO: DEBUG-ONLY, remove
54 -- TODO: DEBUG-ONLY, remove
54− ist <- getIState
55+ ctx <- tt_ctxt <$> getIState
55− let depMap = buildDepMap (tt_ctxt ist) used
56+ let depMap = buildDepMap ctx used
56 let printItem (cond, deps) = show (S.toList cond) ++ " -> " ++ show (S.toList deps)
57 let printItem (cond, deps) = show (S.toList cond) ++ " -> " ++ show (S.toList deps)
57 iLOG $ "USAGE ANALYSIS:\n" ++ unlines (map printItem . M.toList $ depMap)
58 iLOG $ "USAGE ANALYSIS:\n" ++ unlines (map printItem . M.toList $ depMap)
58
59
60+ let fmtDepMap = unlines . map (\(n,is) -> show n ++ " -> " ++ show (IS.toList is)) . M.toList
59 let minUse = minimalUsage depMap
61 let minUse = minimalUsage depMap
60− iLOG $ "MINIMAL USAGE:\n" ++ unlines (map (\(n,is) -> show n ++ " -> " ++ show (IS.toList is)) $ M.toList minUse)
62+ iLOG $ "MINIMAL USAGE:\n" ++ fmtDepMap minUse
63+
64+ let unusedMap = usedToUnused ctx minUse
65+ iLOG $ "UNUSED:\n" ++ fmtDepMap unusedMap
61 -- END TODO
66 -- END TODO
62
67
63 maindef <- irMain tm
68 maindef <- irMain tm
src/Idris/Erasure.hs+16
@@ -4,6 +4,7 @@ module Idris.Erasure
4 ( findUnusedArgs
4 ( findUnusedArgs
5 , buildDepMap
5 , buildDepMap
6 , minimalUsage
6 , minimalUsage
7+ , usedToUnused
7 ) where
8 ) where
8
9
9import Idris.AbsSyntax
10import Idris.AbsSyntax
@@ -49,6 +50,21 @@ type Cond = Set Node
49type Var = Set Node
50type Var = Set Node
50type Vars = Map Name Var
51type Vars = Map Name Var
51
52
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+
52-- Find the minimal consistent usage by forward chaining.
68-- Find the minimal consistent usage by forward chaining.
53minimalUsage :: Deps -> UseMap
69minimalUsage :: Deps -> UseMap
54minimalUsage = gather . forwardChain
70minimalUsage = gather . forwardChain