git.iko.soy/Idris-dev
on master help sign in
Redefine dep analysis data structures.
aff2988Matus Tejiscak
src/IRTS/Compiler.hs+1−1
compare with master
unifiedsplit
@@ -41,7 +41,7 @@ compile codegen f tm
41 = do checkMVs
41 = do checkMVs
42 let tmnames = namesUsed (STerm tm)
42 let tmnames = namesUsed (STerm tm)
43 usedIn <- mapM (allNames []) tmnames
43 usedIn <- mapM (allNames []) tmnames
44− let used = sUN "prim__subBigInt" : sUN "prim__addBigInt"] : concat usedIn
44+ let used = sUN "prim__subBigInt" : sUN "prim__addBigInt" : concat usedIn
45 defsIn <- mkDecls tm used
45 defsIn <- mkDecls tm used
46 findUnusedArgs used
46 findUnusedArgs used
47
47
src/Idris/Erasure.hs+9−23
@@ -28,37 +28,23 @@ import Data.IntMap (IntMap)
28-- UseMap maps names to the set of used (reachable) argument positions.
28-- UseMap maps names to the set of used (reachable) argument positions.
29type UseMap = Map Name IntSet
29type UseMap = Map Name IntSet
30
30
31−-- A dependency, potential edge in the dep graph.
31+type Deps = IntMap (Set (Name, Int))
32−-- Every dependency belongs to a certain Idris function.
33−-- For the effect to take place, the condition must be true.
34−data Dep = Dep
35− -- Effect
36− { depArg :: Int -- | This argument of the function should be marked as used.
37− , depCtors :: Set (Name, Int) -- | These ctor fields should be marked as used.
38− , depTags :: Set Name -- | Tags of these ADTs should be marked as used.
39−
40− -- Condition
41− , depGuards :: Set (Name, Int) -- | All these arguments must be marked as used.
42− }
43− deriving (Eq, Ord, Show)
44−
45−-- DepMap maps function names to their sets of dependencies.
46−type DepMap = Map Name (Set Dep)
32+type DepMap = Map Name Deps
47
33
48−findUsed :: Context -> Ctxt CGInfo -> [Name] -> UseMap
34+findUsed :: Context -> Ctxt CGInfo -> [Name] -> DepMap
49findUsed ctx cg ns = M.fromList [(n, getDeps n) | n <- ns]
35findUsed ctx cg ns = M.fromList [(n, getDeps n) | n <- ns]
50 where
36 where
51− getDeps :: Name -> Set Dep
37+ getDeps :: Name -> Deps
52 getDeps n = case lookupDef n ctx of
38 getDeps n = case lookupDef n ctx of
53 [def] -> getDepsDef def
39 [def] -> getDepsDef def
54 [] -> error $ "erasure checker: unknown name: " ++ show n
40 [] -> error $ "erasure checker: unknown name: " ++ show n
55 _ -> error $ "erasure checker: ambiguous name: " ++ show n
41 _ -> error $ "erasure checker: ambiguous name: " ++ show n
56
42
57− getDepsDef :: Def -> Set Dep
43+ getDepsDef :: Def -> Deps
58− getDepsDef (Function ty t) = S.empty
44+ getDepsDef (Function ty t) = IM.empty
59− getDepsDef (TyDecl ty t) = S.empty
45+ getDepsDef (TyDecl ty t) = IM.empty
60− getDepsDef (Operator ty n f) = S.empty
46+ getDepsDef (Operator ty n f) = IM.empty
61− getDepsDef (CaseOp ci ty tys def tot cdefs) = S.empty
47+ getDepsDef (CaseOp ci ty tys def tot cdefs) = IM.empty
62
48
63{-
49{-
64buildDepGraph :: Context -> Ctxt CGInfo -> [Name] -> DepGraph
50buildDepGraph :: Context -> Ctxt CGInfo -> [Name] -> DepGraph