PageRenderTime 52ms CodeModel.GetById 21ms RepoModel.GetById 0ms app.codeStats 0ms

/compiler/basicTypes/VarEnv.hs

http://github.com/ghc/ghc
Haskell | 587 lines | 328 code | 93 blank | 166 comment | 3 complexity | ccd922b6a562adef82ef75c5b5a89ed8 MD5 | raw file
Possible License(s): MIT, BSD-3-Clause, GPL-3.0
  1. {-
  2. (c) The University of Glasgow 2006
  3. (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
  4. -}
  5. module VarEnv (
  6. -- * Var, Id and TyVar environments (maps)
  7. VarEnv, IdEnv, TyVarEnv, CoVarEnv, TyCoVarEnv,
  8. -- ** Manipulating these environments
  9. emptyVarEnv, unitVarEnv, mkVarEnv, mkVarEnv_Directly,
  10. elemVarEnv,
  11. extendVarEnv, extendVarEnv_C, extendVarEnv_Acc, extendVarEnv_Directly,
  12. extendVarEnvList,
  13. plusVarEnv, plusVarEnv_C, plusVarEnv_CD, alterVarEnv,
  14. delVarEnvList, delVarEnv, delVarEnv_Directly,
  15. minusVarEnv, intersectsVarEnv,
  16. lookupVarEnv, lookupVarEnv_NF, lookupWithDefaultVarEnv,
  17. mapVarEnv, zipVarEnv,
  18. modifyVarEnv, modifyVarEnv_Directly,
  19. isEmptyVarEnv,
  20. elemVarEnvByKey, lookupVarEnv_Directly,
  21. filterVarEnv, filterVarEnv_Directly, restrictVarEnv,
  22. partitionVarEnv,
  23. -- * Deterministic Var environments (maps)
  24. DVarEnv, DIdEnv, DTyVarEnv,
  25. -- ** Manipulating these environments
  26. emptyDVarEnv, mkDVarEnv,
  27. dVarEnvElts,
  28. extendDVarEnv, extendDVarEnv_C,
  29. extendDVarEnvList,
  30. lookupDVarEnv,
  31. isEmptyDVarEnv, foldDVarEnv,
  32. mapDVarEnv,
  33. modifyDVarEnv,
  34. alterDVarEnv,
  35. plusDVarEnv, plusDVarEnv_C,
  36. unitDVarEnv,
  37. delDVarEnv,
  38. delDVarEnvList,
  39. partitionDVarEnv,
  40. anyDVarEnv,
  41. -- * The InScopeSet type
  42. InScopeSet,
  43. -- ** Operations on InScopeSets
  44. emptyInScopeSet, mkInScopeSet, delInScopeSet,
  45. extendInScopeSet, extendInScopeSetList, extendInScopeSetSet,
  46. getInScopeVars, lookupInScope, lookupInScope_Directly,
  47. unionInScope, elemInScopeSet, uniqAway,
  48. varSetInScope,
  49. -- * The RnEnv2 type
  50. RnEnv2,
  51. -- ** Operations on RnEnv2s
  52. mkRnEnv2, rnBndr2, rnBndrs2, rnBndr2_var,
  53. rnOccL, rnOccR, inRnEnvL, inRnEnvR, rnOccL_maybe, rnOccR_maybe,
  54. rnBndrL, rnBndrR, nukeRnEnvL, nukeRnEnvR, rnSwap,
  55. delBndrL, delBndrR, delBndrsL, delBndrsR,
  56. addRnInScopeSet,
  57. rnEtaL, rnEtaR,
  58. rnInScope, rnInScopeSet, lookupRnInScope,
  59. rnEnvL, rnEnvR,
  60. -- * TidyEnv and its operation
  61. TidyEnv,
  62. emptyTidyEnv
  63. ) where
  64. import OccName
  65. import Var
  66. import VarSet
  67. import UniqFM
  68. import UniqDFM
  69. import Unique
  70. import Util
  71. import Maybes
  72. import Outputable
  73. import StaticFlags
  74. {-
  75. ************************************************************************
  76. * *
  77. In-scope sets
  78. * *
  79. ************************************************************************
  80. -}
  81. -- | A set of variables that are in scope at some point
  82. -- "Secrets of the Glasgow Haskell Compiler inliner" Section 3.2 provides
  83. -- the motivation for this abstraction.
  84. data InScopeSet = InScope (VarEnv Var) {-# UNPACK #-} !Int
  85. -- The (VarEnv Var) is just a VarSet. But we write it like
  86. -- this to remind ourselves that you can look up a Var in
  87. -- the InScopeSet. Typically the InScopeSet contains the
  88. -- canonical version of the variable (e.g. with an informative
  89. -- unfolding), so this lookup is useful.
  90. --
  91. -- INVARIANT: the VarEnv maps (the Unique of) a variable to
  92. -- a variable with the same Unique. (This was not
  93. -- the case in the past, when we had a grevious hack
  94. -- mapping var1 to var2.
  95. --
  96. -- The Int is a kind of hash-value used by uniqAway
  97. -- For example, it might be the size of the set
  98. -- INVARIANT: it's not zero; we use it as a multiplier in uniqAway
  99. instance Outputable InScopeSet where
  100. ppr (InScope s _) =
  101. text "InScope" <+> braces (fsep (map (ppr . Var.varName) (nonDetEltsUFM s)))
  102. -- It's OK to use nonDetEltsUFM here because it's
  103. -- only for pretty printing
  104. -- In-scope sets get big, and with -dppr-debug
  105. -- the output is overwhelming
  106. emptyInScopeSet :: InScopeSet
  107. emptyInScopeSet = InScope emptyVarSet 1
  108. getInScopeVars :: InScopeSet -> VarEnv Var
  109. getInScopeVars (InScope vs _) = vs
  110. mkInScopeSet :: VarEnv Var -> InScopeSet
  111. mkInScopeSet in_scope = InScope in_scope 1
  112. extendInScopeSet :: InScopeSet -> Var -> InScopeSet
  113. extendInScopeSet (InScope in_scope n) v = InScope (extendVarEnv in_scope v v) (n + 1)
  114. extendInScopeSetList :: InScopeSet -> [Var] -> InScopeSet
  115. extendInScopeSetList (InScope in_scope n) vs
  116. = InScope (foldl (\s v -> extendVarEnv s v v) in_scope vs)
  117. (n + length vs)
  118. extendInScopeSetSet :: InScopeSet -> VarEnv Var -> InScopeSet
  119. extendInScopeSetSet (InScope in_scope n) vs
  120. = InScope (in_scope `plusVarEnv` vs) (n + sizeUFM vs)
  121. delInScopeSet :: InScopeSet -> Var -> InScopeSet
  122. delInScopeSet (InScope in_scope n) v = InScope (in_scope `delVarEnv` v) n
  123. elemInScopeSet :: Var -> InScopeSet -> Bool
  124. elemInScopeSet v (InScope in_scope _) = v `elemVarEnv` in_scope
  125. -- | Look up a variable the 'InScopeSet'. This lets you map from
  126. -- the variable's identity (unique) to its full value.
  127. lookupInScope :: InScopeSet -> Var -> Maybe Var
  128. lookupInScope (InScope in_scope _) v = lookupVarEnv in_scope v
  129. lookupInScope_Directly :: InScopeSet -> Unique -> Maybe Var
  130. lookupInScope_Directly (InScope in_scope _) uniq
  131. = lookupVarEnv_Directly in_scope uniq
  132. unionInScope :: InScopeSet -> InScopeSet -> InScopeSet
  133. unionInScope (InScope s1 _) (InScope s2 n2)
  134. = InScope (s1 `plusVarEnv` s2) n2
  135. varSetInScope :: VarSet -> InScopeSet -> Bool
  136. varSetInScope vars (InScope s1 _) = vars `subVarSet` s1
  137. -- | @uniqAway in_scope v@ finds a unique that is not used in the
  138. -- in-scope set, and gives that to v.
  139. uniqAway :: InScopeSet -> Var -> Var
  140. -- It starts with v's current unique, of course, in the hope that it won't
  141. -- have to change, and thereafter uses a combination of that and the hash-code
  142. -- found in the in-scope set
  143. uniqAway in_scope var
  144. | var `elemInScopeSet` in_scope = uniqAway' in_scope var -- Make a new one
  145. | otherwise = var -- Nothing to do
  146. uniqAway' :: InScopeSet -> Var -> Var
  147. -- This one *always* makes up a new variable
  148. uniqAway' (InScope set n) var
  149. = try 1
  150. where
  151. orig_unique = getUnique var
  152. try k
  153. | debugIsOn && (k > 1000)
  154. = pprPanic "uniqAway loop:" (ppr k <+> text "tries" <+> ppr var <+> int n)
  155. | uniq `elemVarSetByKey` set = try (k + 1)
  156. | debugIsOn && opt_PprStyle_Debug && (k > 3)
  157. = pprTrace "uniqAway:" (ppr k <+> text "tries" <+> ppr var <+> int n)
  158. setVarUnique var uniq
  159. | otherwise = setVarUnique var uniq
  160. where
  161. uniq = deriveUnique orig_unique (n * k)
  162. {-
  163. ************************************************************************
  164. * *
  165. Dual renaming
  166. * *
  167. ************************************************************************
  168. -}
  169. -- | Rename Environment 2
  170. --
  171. -- When we are comparing (or matching) types or terms, we are faced with
  172. -- \"going under\" corresponding binders. E.g. when comparing:
  173. --
  174. -- > \x. e1 ~ \y. e2
  175. --
  176. -- Basically we want to rename [@x@ -> @y@] or [@y@ -> @x@], but there are lots of
  177. -- things we must be careful of. In particular, @x@ might be free in @e2@, or
  178. -- y in @e1@. So the idea is that we come up with a fresh binder that is free
  179. -- in neither, and rename @x@ and @y@ respectively. That means we must maintain:
  180. --
  181. -- 1. A renaming for the left-hand expression
  182. --
  183. -- 2. A renaming for the right-hand expressions
  184. --
  185. -- 3. An in-scope set
  186. --
  187. -- Furthermore, when matching, we want to be able to have an 'occurs check',
  188. -- to prevent:
  189. --
  190. -- > \x. f ~ \y. y
  191. --
  192. -- matching with [@f@ -> @y@]. So for each expression we want to know that set of
  193. -- locally-bound variables. That is precisely the domain of the mappings 1.
  194. -- and 2., but we must ensure that we always extend the mappings as we go in.
  195. --
  196. -- All of this information is bundled up in the 'RnEnv2'
  197. data RnEnv2
  198. = RV2 { envL :: VarEnv Var -- Renaming for Left term
  199. , envR :: VarEnv Var -- Renaming for Right term
  200. , in_scope :: InScopeSet } -- In scope in left or right terms
  201. -- The renamings envL and envR are *guaranteed* to contain a binding
  202. -- for every variable bound as we go into the term, even if it is not
  203. -- renamed. That way we can ask what variables are locally bound
  204. -- (inRnEnvL, inRnEnvR)
  205. mkRnEnv2 :: InScopeSet -> RnEnv2
  206. mkRnEnv2 vars = RV2 { envL = emptyVarEnv
  207. , envR = emptyVarEnv
  208. , in_scope = vars }
  209. addRnInScopeSet :: RnEnv2 -> VarEnv Var -> RnEnv2
  210. addRnInScopeSet env vs
  211. | isEmptyVarEnv vs = env
  212. | otherwise = env { in_scope = extendInScopeSetSet (in_scope env) vs }
  213. rnInScope :: Var -> RnEnv2 -> Bool
  214. rnInScope x env = x `elemInScopeSet` in_scope env
  215. rnInScopeSet :: RnEnv2 -> InScopeSet
  216. rnInScopeSet = in_scope
  217. -- | Retrieve the left mapping
  218. rnEnvL :: RnEnv2 -> VarEnv Var
  219. rnEnvL = envL
  220. -- | Retrieve the right mapping
  221. rnEnvR :: RnEnv2 -> VarEnv Var
  222. rnEnvR = envR
  223. rnBndrs2 :: RnEnv2 -> [Var] -> [Var] -> RnEnv2
  224. -- ^ Applies 'rnBndr2' to several variables: the two variable lists must be of equal length
  225. rnBndrs2 env bsL bsR = foldl2 rnBndr2 env bsL bsR
  226. rnBndr2 :: RnEnv2 -> Var -> Var -> RnEnv2
  227. -- ^ @rnBndr2 env bL bR@ goes under a binder @bL@ in the Left term,
  228. -- and binder @bR@ in the Right term.
  229. -- It finds a new binder, @new_b@,
  230. -- and returns an environment mapping @bL -> new_b@ and @bR -> new_b@
  231. rnBndr2 env bL bR = fst $ rnBndr2_var env bL bR
  232. rnBndr2_var :: RnEnv2 -> Var -> Var -> (RnEnv2, Var)
  233. -- ^ Similar to 'rnBndr2' but returns the new variable as well as the
  234. -- new environment
  235. rnBndr2_var (RV2 { envL = envL, envR = envR, in_scope = in_scope }) bL bR
  236. = (RV2 { envL = extendVarEnv envL bL new_b -- See Note
  237. , envR = extendVarEnv envR bR new_b -- [Rebinding]
  238. , in_scope = extendInScopeSet in_scope new_b }, new_b)
  239. where
  240. -- Find a new binder not in scope in either term
  241. new_b | not (bL `elemInScopeSet` in_scope) = bL
  242. | not (bR `elemInScopeSet` in_scope) = bR
  243. | otherwise = uniqAway' in_scope bL
  244. -- Note [Rebinding]
  245. -- If the new var is the same as the old one, note that
  246. -- the extendVarEnv *deletes* any current renaming
  247. -- E.g. (\x. \x. ...) ~ (\y. \z. ...)
  248. --
  249. -- Inside \x \y { [x->y], [y->y], {y} }
  250. -- \x \z { [x->x], [y->y, z->x], {y,x} }
  251. rnBndrL :: RnEnv2 -> Var -> (RnEnv2, Var)
  252. -- ^ Similar to 'rnBndr2' but used when there's a binder on the left
  253. -- side only.
  254. rnBndrL (RV2 { envL = envL, envR = envR, in_scope = in_scope }) bL
  255. = (RV2 { envL = extendVarEnv envL bL new_b
  256. , envR = envR
  257. , in_scope = extendInScopeSet in_scope new_b }, new_b)
  258. where
  259. new_b = uniqAway in_scope bL
  260. rnBndrR :: RnEnv2 -> Var -> (RnEnv2, Var)
  261. -- ^ Similar to 'rnBndr2' but used when there's a binder on the right
  262. -- side only.
  263. rnBndrR (RV2 { envL = envL, envR = envR, in_scope = in_scope }) bR
  264. = (RV2 { envR = extendVarEnv envR bR new_b
  265. , envL = envL
  266. , in_scope = extendInScopeSet in_scope new_b }, new_b)
  267. where
  268. new_b = uniqAway in_scope bR
  269. rnEtaL :: RnEnv2 -> Var -> (RnEnv2, Var)
  270. -- ^ Similar to 'rnBndrL' but used for eta expansion
  271. -- See Note [Eta expansion]
  272. rnEtaL (RV2 { envL = envL, envR = envR, in_scope = in_scope }) bL
  273. = (RV2 { envL = extendVarEnv envL bL new_b
  274. , envR = extendVarEnv envR new_b new_b -- Note [Eta expansion]
  275. , in_scope = extendInScopeSet in_scope new_b }, new_b)
  276. where
  277. new_b = uniqAway in_scope bL
  278. rnEtaR :: RnEnv2 -> Var -> (RnEnv2, Var)
  279. -- ^ Similar to 'rnBndr2' but used for eta expansion
  280. -- See Note [Eta expansion]
  281. rnEtaR (RV2 { envL = envL, envR = envR, in_scope = in_scope }) bR
  282. = (RV2 { envL = extendVarEnv envL new_b new_b -- Note [Eta expansion]
  283. , envR = extendVarEnv envR bR new_b
  284. , in_scope = extendInScopeSet in_scope new_b }, new_b)
  285. where
  286. new_b = uniqAway in_scope bR
  287. delBndrL, delBndrR :: RnEnv2 -> Var -> RnEnv2
  288. delBndrL rn@(RV2 { envL = env, in_scope = in_scope }) v
  289. = rn { envL = env `delVarEnv` v, in_scope = in_scope `extendInScopeSet` v }
  290. delBndrR rn@(RV2 { envR = env, in_scope = in_scope }) v
  291. = rn { envR = env `delVarEnv` v, in_scope = in_scope `extendInScopeSet` v }
  292. delBndrsL, delBndrsR :: RnEnv2 -> [Var] -> RnEnv2
  293. delBndrsL rn@(RV2 { envL = env, in_scope = in_scope }) v
  294. = rn { envL = env `delVarEnvList` v, in_scope = in_scope `extendInScopeSetList` v }
  295. delBndrsR rn@(RV2 { envR = env, in_scope = in_scope }) v
  296. = rn { envR = env `delVarEnvList` v, in_scope = in_scope `extendInScopeSetList` v }
  297. rnOccL, rnOccR :: RnEnv2 -> Var -> Var
  298. -- ^ Look up the renaming of an occurrence in the left or right term
  299. rnOccL (RV2 { envL = env }) v = lookupVarEnv env v `orElse` v
  300. rnOccR (RV2 { envR = env }) v = lookupVarEnv env v `orElse` v
  301. rnOccL_maybe, rnOccR_maybe :: RnEnv2 -> Var -> Maybe Var
  302. -- ^ Look up the renaming of an occurrence in the left or right term
  303. rnOccL_maybe (RV2 { envL = env }) v = lookupVarEnv env v
  304. rnOccR_maybe (RV2 { envR = env }) v = lookupVarEnv env v
  305. inRnEnvL, inRnEnvR :: RnEnv2 -> Var -> Bool
  306. -- ^ Tells whether a variable is locally bound
  307. inRnEnvL (RV2 { envL = env }) v = v `elemVarEnv` env
  308. inRnEnvR (RV2 { envR = env }) v = v `elemVarEnv` env
  309. lookupRnInScope :: RnEnv2 -> Var -> Var
  310. lookupRnInScope env v = lookupInScope (in_scope env) v `orElse` v
  311. nukeRnEnvL, nukeRnEnvR :: RnEnv2 -> RnEnv2
  312. -- ^ Wipe the left or right side renaming
  313. nukeRnEnvL env = env { envL = emptyVarEnv }
  314. nukeRnEnvR env = env { envR = emptyVarEnv }
  315. rnSwap :: RnEnv2 -> RnEnv2
  316. -- ^ swap the meaning of left and right
  317. rnSwap (RV2 { envL = envL, envR = envR, in_scope = in_scope })
  318. = RV2 { envL = envR, envR = envL, in_scope = in_scope }
  319. {-
  320. Note [Eta expansion]
  321. ~~~~~~~~~~~~~~~~~~~~
  322. When matching
  323. (\x.M) ~ N
  324. we rename x to x' with, where x' is not in scope in
  325. either term. Then we want to behave as if we'd seen
  326. (\x'.M) ~ (\x'.N x')
  327. Since x' isn't in scope in N, the form (\x'. N x') doesn't
  328. capture any variables in N. But we must nevertheless extend
  329. the envR with a binding [x' -> x'], to support the occurs check.
  330. For example, if we don't do this, we can get silly matches like
  331. forall a. (\y.a) ~ v
  332. succeeding with [a -> v y], which is bogus of course.
  333. ************************************************************************
  334. * *
  335. Tidying
  336. * *
  337. ************************************************************************
  338. -}
  339. -- | Tidy Environment
  340. --
  341. -- When tidying up print names, we keep a mapping of in-scope occ-names
  342. -- (the 'TidyOccEnv') and a Var-to-Var of the current renamings
  343. type TidyEnv = (TidyOccEnv, VarEnv Var)
  344. emptyTidyEnv :: TidyEnv
  345. emptyTidyEnv = (emptyTidyOccEnv, emptyVarEnv)
  346. {-
  347. ************************************************************************
  348. * *
  349. \subsection{@VarEnv@s}
  350. * *
  351. ************************************************************************
  352. -}
  353. -- | Variable Environment
  354. type VarEnv elt = UniqFM elt
  355. -- | Identifier Environment
  356. type IdEnv elt = VarEnv elt
  357. -- | Type Variable Environment
  358. type TyVarEnv elt = VarEnv elt
  359. -- | Type or Coercion Variable Environment
  360. type TyCoVarEnv elt = VarEnv elt
  361. -- | Coercion Variable Environment
  362. type CoVarEnv elt = VarEnv elt
  363. emptyVarEnv :: VarEnv a
  364. mkVarEnv :: [(Var, a)] -> VarEnv a
  365. mkVarEnv_Directly :: [(Unique, a)] -> VarEnv a
  366. zipVarEnv :: [Var] -> [a] -> VarEnv a
  367. unitVarEnv :: Var -> a -> VarEnv a
  368. alterVarEnv :: (Maybe a -> Maybe a) -> VarEnv a -> Var -> VarEnv a
  369. extendVarEnv :: VarEnv a -> Var -> a -> VarEnv a
  370. extendVarEnv_C :: (a->a->a) -> VarEnv a -> Var -> a -> VarEnv a
  371. extendVarEnv_Acc :: (a->b->b) -> (a->b) -> VarEnv b -> Var -> a -> VarEnv b
  372. extendVarEnv_Directly :: VarEnv a -> Unique -> a -> VarEnv a
  373. plusVarEnv :: VarEnv a -> VarEnv a -> VarEnv a
  374. extendVarEnvList :: VarEnv a -> [(Var, a)] -> VarEnv a
  375. lookupVarEnv_Directly :: VarEnv a -> Unique -> Maybe a
  376. filterVarEnv_Directly :: (Unique -> a -> Bool) -> VarEnv a -> VarEnv a
  377. delVarEnv_Directly :: VarEnv a -> Unique -> VarEnv a
  378. partitionVarEnv :: (a -> Bool) -> VarEnv a -> (VarEnv a, VarEnv a)
  379. restrictVarEnv :: VarEnv a -> VarSet -> VarEnv a
  380. delVarEnvList :: VarEnv a -> [Var] -> VarEnv a
  381. delVarEnv :: VarEnv a -> Var -> VarEnv a
  382. minusVarEnv :: VarEnv a -> VarEnv b -> VarEnv a
  383. intersectsVarEnv :: VarEnv a -> VarEnv a -> Bool
  384. plusVarEnv_C :: (a -> a -> a) -> VarEnv a -> VarEnv a -> VarEnv a
  385. plusVarEnv_CD :: (a -> a -> a) -> VarEnv a -> a -> VarEnv a -> a -> VarEnv a
  386. mapVarEnv :: (a -> b) -> VarEnv a -> VarEnv b
  387. modifyVarEnv :: (a -> a) -> VarEnv a -> Var -> VarEnv a
  388. isEmptyVarEnv :: VarEnv a -> Bool
  389. lookupVarEnv :: VarEnv a -> Var -> Maybe a
  390. filterVarEnv :: (a -> Bool) -> VarEnv a -> VarEnv a
  391. lookupVarEnv_NF :: VarEnv a -> Var -> a
  392. lookupWithDefaultVarEnv :: VarEnv a -> a -> Var -> a
  393. elemVarEnv :: Var -> VarEnv a -> Bool
  394. elemVarEnvByKey :: Unique -> VarEnv a -> Bool
  395. elemVarEnv = elemUFM
  396. elemVarEnvByKey = elemUFM_Directly
  397. alterVarEnv = alterUFM
  398. extendVarEnv = addToUFM
  399. extendVarEnv_C = addToUFM_C
  400. extendVarEnv_Acc = addToUFM_Acc
  401. extendVarEnv_Directly = addToUFM_Directly
  402. extendVarEnvList = addListToUFM
  403. plusVarEnv_C = plusUFM_C
  404. plusVarEnv_CD = plusUFM_CD
  405. delVarEnvList = delListFromUFM
  406. delVarEnv = delFromUFM
  407. minusVarEnv = minusUFM
  408. intersectsVarEnv e1 e2 = not (isEmptyVarEnv (e1 `intersectUFM` e2))
  409. plusVarEnv = plusUFM
  410. lookupVarEnv = lookupUFM
  411. filterVarEnv = filterUFM
  412. lookupWithDefaultVarEnv = lookupWithDefaultUFM
  413. mapVarEnv = mapUFM
  414. mkVarEnv = listToUFM
  415. mkVarEnv_Directly= listToUFM_Directly
  416. emptyVarEnv = emptyUFM
  417. unitVarEnv = unitUFM
  418. isEmptyVarEnv = isNullUFM
  419. lookupVarEnv_Directly = lookupUFM_Directly
  420. filterVarEnv_Directly = filterUFM_Directly
  421. delVarEnv_Directly = delFromUFM_Directly
  422. partitionVarEnv = partitionUFM
  423. restrictVarEnv env vs = filterVarEnv_Directly keep env
  424. where
  425. keep u _ = u `elemVarSetByKey` vs
  426. zipVarEnv tyvars tys = mkVarEnv (zipEqual "zipVarEnv" tyvars tys)
  427. lookupVarEnv_NF env id = case lookupVarEnv env id of
  428. Just xx -> xx
  429. Nothing -> panic "lookupVarEnv_NF: Nothing"
  430. {-
  431. @modifyVarEnv@: Look up a thing in the VarEnv,
  432. then mash it with the modify function, and put it back.
  433. -}
  434. modifyVarEnv mangle_fn env key
  435. = case (lookupVarEnv env key) of
  436. Nothing -> env
  437. Just xx -> extendVarEnv env key (mangle_fn xx)
  438. modifyVarEnv_Directly :: (a -> a) -> UniqFM a -> Unique -> UniqFM a
  439. modifyVarEnv_Directly mangle_fn env key
  440. = case (lookupUFM_Directly env key) of
  441. Nothing -> env
  442. Just xx -> addToUFM_Directly env key (mangle_fn xx)
  443. -- Deterministic VarEnv
  444. -- See Note [Deterministic UniqFM] in UniqDFM for explanation why we need
  445. -- DVarEnv.
  446. -- | Deterministic Variable Environment
  447. type DVarEnv elt = UniqDFM elt
  448. -- | Deterministic Identifier Environment
  449. type DIdEnv elt = DVarEnv elt
  450. -- | Deterministic Type Variable Environment
  451. type DTyVarEnv elt = DVarEnv elt
  452. emptyDVarEnv :: DVarEnv a
  453. emptyDVarEnv = emptyUDFM
  454. dVarEnvElts :: DVarEnv a -> [a]
  455. dVarEnvElts = eltsUDFM
  456. mkDVarEnv :: [(Var, a)] -> DVarEnv a
  457. mkDVarEnv = listToUDFM
  458. extendDVarEnv :: DVarEnv a -> Var -> a -> DVarEnv a
  459. extendDVarEnv = addToUDFM
  460. lookupDVarEnv :: DVarEnv a -> Var -> Maybe a
  461. lookupDVarEnv = lookupUDFM
  462. foldDVarEnv :: (a -> b -> b) -> b -> DVarEnv a -> b
  463. foldDVarEnv = foldUDFM
  464. mapDVarEnv :: (a -> b) -> DVarEnv a -> DVarEnv b
  465. mapDVarEnv = mapUDFM
  466. alterDVarEnv :: (Maybe a -> Maybe a) -> DVarEnv a -> Var -> DVarEnv a
  467. alterDVarEnv = alterUDFM
  468. plusDVarEnv :: DVarEnv a -> DVarEnv a -> DVarEnv a
  469. plusDVarEnv = plusUDFM
  470. plusDVarEnv_C :: (a -> a -> a) -> DVarEnv a -> DVarEnv a -> DVarEnv a
  471. plusDVarEnv_C = plusUDFM_C
  472. unitDVarEnv :: Var -> a -> DVarEnv a
  473. unitDVarEnv = unitUDFM
  474. delDVarEnv :: DVarEnv a -> Var -> DVarEnv a
  475. delDVarEnv = delFromUDFM
  476. delDVarEnvList :: DVarEnv a -> [Var] -> DVarEnv a
  477. delDVarEnvList = delListFromUDFM
  478. isEmptyDVarEnv :: DVarEnv a -> Bool
  479. isEmptyDVarEnv = isNullUDFM
  480. extendDVarEnv_C :: (a -> a -> a) -> DVarEnv a -> Var -> a -> DVarEnv a
  481. extendDVarEnv_C = addToUDFM_C
  482. modifyDVarEnv :: (a -> a) -> DVarEnv a -> Var -> DVarEnv a
  483. modifyDVarEnv mangle_fn env key
  484. = case (lookupDVarEnv env key) of
  485. Nothing -> env
  486. Just xx -> extendDVarEnv env key (mangle_fn xx)
  487. partitionDVarEnv :: (a -> Bool) -> DVarEnv a -> (DVarEnv a, DVarEnv a)
  488. partitionDVarEnv = partitionUDFM
  489. extendDVarEnvList :: DVarEnv a -> [(Var, a)] -> DVarEnv a
  490. extendDVarEnvList = addListToUDFM
  491. anyDVarEnv :: (a -> Bool) -> DVarEnv a -> Bool
  492. anyDVarEnv = anyUDFM