PageRenderTime 53ms CodeModel.GetById 27ms RepoModel.GetById 0ms app.codeStats 0ms

/compiler/basicTypes/NameEnv.lhs

https://bitbucket.org/carter/ghc
Haskell | 122 lines | 93 code | 16 blank | 13 comment | 0 complexity | dd4c594d72a6b341dc851709767b0971 MD5 | raw file
  1. %
  2. % (c) The University of Glasgow 2006
  3. % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
  4. %
  5. \section[NameEnv]{@NameEnv@: name environments}
  6. \begin{code}
  7. {-# OPTIONS -fno-warn-tabs #-}
  8. -- The above warning supression flag is a temporary kludge.
  9. -- While working on this module you are encouraged to remove it and
  10. -- detab the module (please do the detabbing in a separate patch). See
  11. -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
  12. -- for details
  13. module NameEnv (
  14. -- * Var, Id and TyVar environments (maps)
  15. NameEnv,
  16. -- ** Manipulating these environments
  17. mkNameEnv,
  18. emptyNameEnv, unitNameEnv, nameEnvElts, nameEnvUniqueElts,
  19. extendNameEnv_C, extendNameEnv_Acc, extendNameEnv,
  20. extendNameEnvList, extendNameEnvList_C,
  21. foldNameEnv, filterNameEnv,
  22. plusNameEnv, plusNameEnv_C, alterNameEnv,
  23. lookupNameEnv, lookupNameEnv_NF, delFromNameEnv, delListFromNameEnv,
  24. elemNameEnv, mapNameEnv,
  25. -- ** Dependency analysis
  26. depAnal
  27. ) where
  28. #include "HsVersions.h"
  29. import Digraph
  30. import Name
  31. import Unique
  32. import UniqFM
  33. import Maybes
  34. \end{code}
  35. %************************************************************************
  36. %* *
  37. \subsection{Name environment}
  38. %* *
  39. %************************************************************************
  40. \begin{code}
  41. depAnal :: (node -> [Name]) -- Defs
  42. -> (node -> [Name]) -- Uses
  43. -> [node]
  44. -> [SCC node]
  45. -- Peform dependency analysis on a group of definitions,
  46. -- where each definition may define more than one Name
  47. --
  48. -- The get_defs and get_uses functions are called only once per node
  49. depAnal get_defs get_uses nodes
  50. = stronglyConnCompFromEdgedVertices (map mk_node keyed_nodes)
  51. where
  52. keyed_nodes = nodes `zip` [(1::Int)..]
  53. mk_node (node, key) = (node, key, mapCatMaybes (lookupNameEnv key_map) (get_uses node))
  54. key_map :: NameEnv Int -- Maps a Name to the key of the decl that defines it
  55. key_map = mkNameEnv [(name,key) | (node, key) <- keyed_nodes, name <- get_defs node]
  56. \end{code}
  57. %************************************************************************
  58. %* *
  59. \subsection{Name environment}
  60. %* *
  61. %************************************************************************
  62. \begin{code}
  63. type NameEnv a = UniqFM a -- Domain is Name
  64. emptyNameEnv :: NameEnv a
  65. mkNameEnv :: [(Name,a)] -> NameEnv a
  66. nameEnvElts :: NameEnv a -> [a]
  67. nameEnvUniqueElts :: NameEnv a -> [(Unique, a)]
  68. alterNameEnv :: (Maybe a-> Maybe a) -> NameEnv a -> Name -> NameEnv a
  69. extendNameEnv_C :: (a->a->a) -> NameEnv a -> Name -> a -> NameEnv a
  70. extendNameEnv_Acc :: (a->b->b) -> (a->b) -> NameEnv b -> Name -> a -> NameEnv b
  71. extendNameEnv :: NameEnv a -> Name -> a -> NameEnv a
  72. plusNameEnv :: NameEnv a -> NameEnv a -> NameEnv a
  73. plusNameEnv_C :: (a->a->a) -> NameEnv a -> NameEnv a -> NameEnv a
  74. extendNameEnvList :: NameEnv a -> [(Name,a)] -> NameEnv a
  75. extendNameEnvList_C :: (a->a->a) -> NameEnv a -> [(Name,a)] -> NameEnv a
  76. delFromNameEnv :: NameEnv a -> Name -> NameEnv a
  77. delListFromNameEnv :: NameEnv a -> [Name] -> NameEnv a
  78. elemNameEnv :: Name -> NameEnv a -> Bool
  79. unitNameEnv :: Name -> a -> NameEnv a
  80. lookupNameEnv :: NameEnv a -> Name -> Maybe a
  81. lookupNameEnv_NF :: NameEnv a -> Name -> a
  82. foldNameEnv :: (a -> b -> b) -> b -> NameEnv a -> b
  83. filterNameEnv :: (elt -> Bool) -> NameEnv elt -> NameEnv elt
  84. mapNameEnv :: (elt1 -> elt2) -> NameEnv elt1 -> NameEnv elt2
  85. nameEnvElts x = eltsUFM x
  86. emptyNameEnv = emptyUFM
  87. unitNameEnv x y = unitUFM x y
  88. extendNameEnv x y z = addToUFM x y z
  89. extendNameEnvList x l = addListToUFM x l
  90. lookupNameEnv x y = lookupUFM x y
  91. alterNameEnv = alterUFM
  92. mkNameEnv l = listToUFM l
  93. elemNameEnv x y = elemUFM x y
  94. foldNameEnv a b c = foldUFM a b c
  95. plusNameEnv x y = plusUFM x y
  96. plusNameEnv_C f x y = plusUFM_C f x y
  97. extendNameEnv_C f x y z = addToUFM_C f x y z
  98. mapNameEnv f x = mapUFM f x
  99. nameEnvUniqueElts x = ufmToList x
  100. extendNameEnv_Acc x y z a b = addToUFM_Acc x y z a b
  101. extendNameEnvList_C x y z = addListToUFM_C x y z
  102. delFromNameEnv x y = delFromUFM x y
  103. delListFromNameEnv x y = delListFromUFM x y
  104. filterNameEnv x y = filterUFM x y
  105. lookupNameEnv_NF env n = expectJust "lookupNameEnv_NF" (lookupNameEnv env n)
  106. \end{code}