PageRenderTime 45ms CodeModel.GetById 14ms RepoModel.GetById 0ms app.codeStats 0ms

/compiler/basicTypes/VarEnv.lhs

http://github.com/ghc/ghc
Haskell | 461 lines | 304 code | 64 blank | 93 comment | 5 complexity | 3f10e2bb3b9bf9ec38282f8d3e59bcbc 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. \begin{code}
  6. {-# OPTIONS -fno-warn-tabs #-}
  7. -- The above warning supression flag is a temporary kludge.
  8. -- While working on this module you are encouraged to remove it and
  9. -- detab the module (please do the detabbing in a separate patch). See
  10. -- http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
  11. -- for details
  12. module VarEnv (
  13. -- * Var, Id and TyVar environments (maps)
  14. VarEnv, IdEnv, TyVarEnv, CoVarEnv,
  15. -- ** Manipulating these environments
  16. emptyVarEnv, unitVarEnv, mkVarEnv,
  17. elemVarEnv, varEnvElts, varEnvKeys,
  18. extendVarEnv, extendVarEnv_C, extendVarEnv_Acc, extendVarEnvList,
  19. plusVarEnv, plusVarEnv_C, alterVarEnv,
  20. delVarEnvList, delVarEnv,
  21. minusVarEnv, intersectsVarEnv,
  22. lookupVarEnv, lookupVarEnv_NF, lookupWithDefaultVarEnv,
  23. mapVarEnv, zipVarEnv,
  24. modifyVarEnv, modifyVarEnv_Directly,
  25. isEmptyVarEnv, foldVarEnv,
  26. elemVarEnvByKey, lookupVarEnv_Directly,
  27. filterVarEnv_Directly, restrictVarEnv,
  28. partitionVarEnv,
  29. -- * The InScopeSet type
  30. InScopeSet,
  31. -- ** Operations on InScopeSets
  32. emptyInScopeSet, mkInScopeSet, delInScopeSet,
  33. extendInScopeSet, extendInScopeSetList, extendInScopeSetSet,
  34. getInScopeVars, lookupInScope, lookupInScope_Directly,
  35. unionInScope, elemInScopeSet, uniqAway,
  36. -- * The RnEnv2 type
  37. RnEnv2,
  38. -- ** Operations on RnEnv2s
  39. mkRnEnv2, rnBndr2, rnBndrs2,
  40. rnOccL, rnOccR, inRnEnvL, inRnEnvR, rnOccL_maybe, rnOccR_maybe,
  41. rnBndrL, rnBndrR, nukeRnEnvL, nukeRnEnvR,
  42. delBndrL, delBndrR, delBndrsL, delBndrsR,
  43. addRnInScopeSet,
  44. rnEtaL, rnEtaR,
  45. rnInScope, rnInScopeSet, lookupRnInScope,
  46. -- * TidyEnv and its operation
  47. TidyEnv,
  48. emptyTidyEnv
  49. ) where
  50. import OccName
  51. import Var
  52. import VarSet
  53. import UniqFM
  54. import Unique
  55. import Util
  56. import Maybes
  57. import Outputable
  58. import FastTypes
  59. import StaticFlags
  60. import FastString
  61. \end{code}
  62. %************************************************************************
  63. %* *
  64. In-scope sets
  65. %* *
  66. %************************************************************************
  67. \begin{code}
  68. -- | A set of variables that are in scope at some point
  69. data InScopeSet = InScope (VarEnv Var) FastInt
  70. -- The (VarEnv Var) is just a VarSet. But we write it like
  71. -- this to remind ourselves that you can look up a Var in
  72. -- the InScopeSet. Typically the InScopeSet contains the
  73. -- canonical version of the variable (e.g. with an informative
  74. -- unfolding), so this lookup is useful.
  75. --
  76. -- INVARIANT: the VarEnv maps (the Unique of) a variable to
  77. -- a variable with the same Uniqua. (This was not
  78. -- the case in the past, when we had a grevious hack
  79. -- mapping var1 to var2.
  80. --
  81. -- The FastInt is a kind of hash-value used by uniqAway
  82. -- For example, it might be the size of the set
  83. -- INVARIANT: it's not zero; we use it as a multiplier in uniqAway
  84. instance Outputable InScopeSet where
  85. ppr (InScope s _) = ptext (sLit "InScope") <+> ppr s
  86. emptyInScopeSet :: InScopeSet
  87. emptyInScopeSet = InScope emptyVarSet (_ILIT(1))
  88. getInScopeVars :: InScopeSet -> VarEnv Var
  89. getInScopeVars (InScope vs _) = vs
  90. mkInScopeSet :: VarEnv Var -> InScopeSet
  91. mkInScopeSet in_scope = InScope in_scope (_ILIT(1))
  92. extendInScopeSet :: InScopeSet -> Var -> InScopeSet
  93. extendInScopeSet (InScope in_scope n) v = InScope (extendVarEnv in_scope v v) (n +# _ILIT(1))
  94. extendInScopeSetList :: InScopeSet -> [Var] -> InScopeSet
  95. extendInScopeSetList (InScope in_scope n) vs
  96. = InScope (foldl (\s v -> extendVarEnv s v v) in_scope vs)
  97. (n +# iUnbox (length vs))
  98. extendInScopeSetSet :: InScopeSet -> VarEnv Var -> InScopeSet
  99. extendInScopeSetSet (InScope in_scope n) vs
  100. = InScope (in_scope `plusVarEnv` vs) (n +# iUnbox (sizeUFM vs))
  101. delInScopeSet :: InScopeSet -> Var -> InScopeSet
  102. delInScopeSet (InScope in_scope n) v = InScope (in_scope `delVarEnv` v) n
  103. elemInScopeSet :: Var -> InScopeSet -> Bool
  104. elemInScopeSet v (InScope in_scope _) = v `elemVarEnv` in_scope
  105. -- | Look up a variable the 'InScopeSet'. This lets you map from
  106. -- the variable's identity (unique) to its full value.
  107. lookupInScope :: InScopeSet -> Var -> Maybe Var
  108. lookupInScope (InScope in_scope _) v = lookupVarEnv in_scope v
  109. lookupInScope_Directly :: InScopeSet -> Unique -> Maybe Var
  110. lookupInScope_Directly (InScope in_scope _) uniq
  111. = lookupVarEnv_Directly in_scope uniq
  112. unionInScope :: InScopeSet -> InScopeSet -> InScopeSet
  113. unionInScope (InScope s1 _) (InScope s2 n2)
  114. = InScope (s1 `plusVarEnv` s2) n2
  115. \end{code}
  116. \begin{code}
  117. -- | @uniqAway in_scope v@ finds a unique that is not used in the
  118. -- in-scope set, and gives that to v.
  119. uniqAway :: InScopeSet -> Var -> Var
  120. -- It starts with v's current unique, of course, in the hope that it won't
  121. -- have to change, and thereafter uses a combination of that and the hash-code
  122. -- found in the in-scope set
  123. uniqAway in_scope var
  124. | var `elemInScopeSet` in_scope = uniqAway' in_scope var -- Make a new one
  125. | otherwise = var -- Nothing to do
  126. uniqAway' :: InScopeSet -> Var -> Var
  127. -- This one *always* makes up a new variable
  128. uniqAway' (InScope set n) var
  129. = try (_ILIT(1))
  130. where
  131. orig_unique = getUnique var
  132. try k
  133. | debugIsOn && (k ># _ILIT(1000))
  134. = pprPanic "uniqAway loop:" (ppr (iBox k) <+> text "tries" <+> ppr var <+> int (iBox n))
  135. | uniq `elemVarSetByKey` set = try (k +# _ILIT(1))
  136. | debugIsOn && opt_PprStyle_Debug && (k ># _ILIT(3))
  137. = pprTrace "uniqAway:" (ppr (iBox k) <+> text "tries" <+> ppr var <+> int (iBox n))
  138. setVarUnique var uniq
  139. | otherwise = setVarUnique var uniq
  140. where
  141. uniq = deriveUnique orig_unique (iBox (n *# k))
  142. \end{code}
  143. %************************************************************************
  144. %* *
  145. Dual renaming
  146. %* *
  147. %************************************************************************
  148. \begin{code}
  149. -- | When we are comparing (or matching) types or terms, we are faced with
  150. -- \"going under\" corresponding binders. E.g. when comparing:
  151. --
  152. -- > \x. e1 ~ \y. e2
  153. --
  154. -- Basically we want to rename [@x@ -> @y@] or [@y@ -> @x@], but there are lots of
  155. -- things we must be careful of. In particular, @x@ might be free in @e2@, or
  156. -- y in @e1@. So the idea is that we come up with a fresh binder that is free
  157. -- in neither, and rename @x@ and @y@ respectively. That means we must maintain:
  158. --
  159. -- 1. A renaming for the left-hand expression
  160. --
  161. -- 2. A renaming for the right-hand expressions
  162. --
  163. -- 3. An in-scope set
  164. --
  165. -- Furthermore, when matching, we want to be able to have an 'occurs check',
  166. -- to prevent:
  167. --
  168. -- > \x. f ~ \y. y
  169. --
  170. -- matching with [@f@ -> @y@]. So for each expression we want to know that set of
  171. -- locally-bound variables. That is precisely the domain of the mappings 1.
  172. -- and 2., but we must ensure that we always extend the mappings as we go in.
  173. --
  174. -- All of this information is bundled up in the 'RnEnv2'
  175. data RnEnv2
  176. = RV2 { envL :: VarEnv Var -- Renaming for Left term
  177. , envR :: VarEnv Var -- Renaming for Right term
  178. , in_scope :: InScopeSet } -- In scope in left or right terms
  179. -- The renamings envL and envR are *guaranteed* to contain a binding
  180. -- for every variable bound as we go into the term, even if it is not
  181. -- renamed. That way we can ask what variables are locally bound
  182. -- (inRnEnvL, inRnEnvR)
  183. mkRnEnv2 :: InScopeSet -> RnEnv2
  184. mkRnEnv2 vars = RV2 { envL = emptyVarEnv
  185. , envR = emptyVarEnv
  186. , in_scope = vars }
  187. addRnInScopeSet :: RnEnv2 -> VarEnv Var -> RnEnv2
  188. addRnInScopeSet env vs
  189. | isEmptyVarEnv vs = env
  190. | otherwise = env { in_scope = extendInScopeSetSet (in_scope env) vs }
  191. rnInScope :: Var -> RnEnv2 -> Bool
  192. rnInScope x env = x `elemInScopeSet` in_scope env
  193. rnInScopeSet :: RnEnv2 -> InScopeSet
  194. rnInScopeSet = in_scope
  195. rnBndrs2 :: RnEnv2 -> [Var] -> [Var] -> RnEnv2
  196. -- ^ Applies 'rnBndr2' to several variables: the two variable lists must be of equal length
  197. rnBndrs2 env bsL bsR = foldl2 rnBndr2 env bsL bsR
  198. rnBndr2 :: RnEnv2 -> Var -> Var -> RnEnv2
  199. -- ^ @rnBndr2 env bL bR@ goes under a binder @bL@ in the Left term,
  200. -- and binder @bR@ in the Right term.
  201. -- It finds a new binder, @new_b@,
  202. -- and returns an environment mapping @bL -> new_b@ and @bR -> new_b@
  203. rnBndr2 (RV2 { envL = envL, envR = envR, in_scope = in_scope }) bL bR
  204. = RV2 { envL = extendVarEnv envL bL new_b -- See Note
  205. , envR = extendVarEnv envR bR new_b -- [Rebinding]
  206. , in_scope = extendInScopeSet in_scope new_b }
  207. where
  208. -- Find a new binder not in scope in either term
  209. new_b | not (bL `elemInScopeSet` in_scope) = bL
  210. | not (bR `elemInScopeSet` in_scope) = bR
  211. | otherwise = uniqAway' in_scope bL
  212. -- Note [Rebinding]
  213. -- If the new var is the same as the old one, note that
  214. -- the extendVarEnv *deletes* any current renaming
  215. -- E.g. (\x. \x. ...) ~ (\y. \z. ...)
  216. --
  217. -- Inside \x \y { [x->y], [y->y], {y} }
  218. -- \x \z { [x->x], [y->y, z->x], {y,x} }
  219. rnBndrL :: RnEnv2 -> Var -> (RnEnv2, Var)
  220. -- ^ Similar to 'rnBndr2' but used when there's a binder on the left
  221. -- side only.
  222. rnBndrL (RV2 { envL = envL, envR = envR, in_scope = in_scope }) bL
  223. = (RV2 { envL = extendVarEnv envL bL new_b
  224. , envR = envR
  225. , in_scope = extendInScopeSet in_scope new_b }, new_b)
  226. where
  227. new_b = uniqAway in_scope bL
  228. rnBndrR :: RnEnv2 -> Var -> (RnEnv2, Var)
  229. -- ^ Similar to 'rnBndr2' but used when there's a binder on the right
  230. -- side only.
  231. rnBndrR (RV2 { envL = envL, envR = envR, in_scope = in_scope }) bR
  232. = (RV2 { envR = extendVarEnv envR bR new_b
  233. , envL = envL
  234. , in_scope = extendInScopeSet in_scope new_b }, new_b)
  235. where
  236. new_b = uniqAway in_scope bR
  237. rnEtaL :: RnEnv2 -> Var -> (RnEnv2, Var)
  238. -- ^ Similar to 'rnBndrL' but used for eta expansion
  239. -- See Note [Eta expansion]
  240. rnEtaL (RV2 { envL = envL, envR = envR, in_scope = in_scope }) bL
  241. = (RV2 { envL = extendVarEnv envL bL new_b
  242. , envR = extendVarEnv envR new_b new_b -- Note [Eta expansion]
  243. , in_scope = extendInScopeSet in_scope new_b }, new_b)
  244. where
  245. new_b = uniqAway in_scope bL
  246. rnEtaR :: RnEnv2 -> Var -> (RnEnv2, Var)
  247. -- ^ Similar to 'rnBndr2' but used for eta expansion
  248. -- See Note [Eta expansion]
  249. rnEtaR (RV2 { envL = envL, envR = envR, in_scope = in_scope }) bR
  250. = (RV2 { envL = extendVarEnv envL new_b new_b -- Note [Eta expansion]
  251. , envR = extendVarEnv envR bR new_b
  252. , in_scope = extendInScopeSet in_scope new_b }, new_b)
  253. where
  254. new_b = uniqAway in_scope bR
  255. delBndrL, delBndrR :: RnEnv2 -> Var -> RnEnv2
  256. delBndrL rn@(RV2 { envL = env, in_scope = in_scope }) v
  257. = rn { envL = env `delVarEnv` v, in_scope = in_scope `extendInScopeSet` v }
  258. delBndrR rn@(RV2 { envR = env, in_scope = in_scope }) v
  259. = rn { envR = env `delVarEnv` v, in_scope = in_scope `extendInScopeSet` v }
  260. delBndrsL, delBndrsR :: RnEnv2 -> [Var] -> RnEnv2
  261. delBndrsL rn@(RV2 { envL = env, in_scope = in_scope }) v
  262. = rn { envL = env `delVarEnvList` v, in_scope = in_scope `extendInScopeSetList` v }
  263. delBndrsR rn@(RV2 { envR = env, in_scope = in_scope }) v
  264. = rn { envR = env `delVarEnvList` v, in_scope = in_scope `extendInScopeSetList` v }
  265. rnOccL, rnOccR :: RnEnv2 -> Var -> Var
  266. -- ^ Look up the renaming of an occurrence in the left or right term
  267. rnOccL (RV2 { envL = env }) v = lookupVarEnv env v `orElse` v
  268. rnOccR (RV2 { envR = env }) v = lookupVarEnv env v `orElse` v
  269. rnOccL_maybe, rnOccR_maybe :: RnEnv2 -> Var -> Maybe Var
  270. -- ^ Look up the renaming of an occurrence in the left or right term
  271. rnOccL_maybe (RV2 { envL = env }) v = lookupVarEnv env v
  272. rnOccR_maybe (RV2 { envR = env }) v = lookupVarEnv env v
  273. inRnEnvL, inRnEnvR :: RnEnv2 -> Var -> Bool
  274. -- ^ Tells whether a variable is locally bound
  275. inRnEnvL (RV2 { envL = env }) v = v `elemVarEnv` env
  276. inRnEnvR (RV2 { envR = env }) v = v `elemVarEnv` env
  277. lookupRnInScope :: RnEnv2 -> Var -> Var
  278. lookupRnInScope env v = lookupInScope (in_scope env) v `orElse` v
  279. nukeRnEnvL, nukeRnEnvR :: RnEnv2 -> RnEnv2
  280. -- ^ Wipe the left or right side renaming
  281. nukeRnEnvL env = env { envL = emptyVarEnv }
  282. nukeRnEnvR env = env { envR = emptyVarEnv }
  283. \end{code}
  284. Note [Eta expansion]
  285. ~~~~~~~~~~~~~~~~~~~~
  286. When matching
  287. (\x.M) ~ N
  288. we rename x to x' with, where x' is not in scope in
  289. either term. Then we want to behave as if we'd seen
  290. (\x'.M) ~ (\x'.N x')
  291. Since x' isn't in scope in N, the form (\x'. N x') doesn't
  292. capture any variables in N. But we must nevertheless extend
  293. the envR with a binding [x' -> x'], to support the occurs check.
  294. For example, if we don't do this, we can get silly matches like
  295. forall a. (\y.a) ~ v
  296. succeeding with [a -> v y], which is bogus of course.
  297. %************************************************************************
  298. %* *
  299. Tidying
  300. %* *
  301. %************************************************************************
  302. \begin{code}
  303. -- | When tidying up print names, we keep a mapping of in-scope occ-names
  304. -- (the 'TidyOccEnv') and a Var-to-Var of the current renamings
  305. type TidyEnv = (TidyOccEnv, VarEnv Var)
  306. emptyTidyEnv :: TidyEnv
  307. emptyTidyEnv = (emptyTidyOccEnv, emptyVarEnv)
  308. \end{code}
  309. %************************************************************************
  310. %* *
  311. \subsection{@VarEnv@s}
  312. %* *
  313. %************************************************************************
  314. \begin{code}
  315. type VarEnv elt = UniqFM elt
  316. type IdEnv elt = VarEnv elt
  317. type TyVarEnv elt = VarEnv elt
  318. type CoVarEnv elt = VarEnv elt
  319. emptyVarEnv :: VarEnv a
  320. mkVarEnv :: [(Var, a)] -> VarEnv a
  321. zipVarEnv :: [Var] -> [a] -> VarEnv a
  322. unitVarEnv :: Var -> a -> VarEnv a
  323. alterVarEnv :: (Maybe a -> Maybe a) -> VarEnv a -> Var -> VarEnv a
  324. extendVarEnv :: VarEnv a -> Var -> a -> VarEnv a
  325. extendVarEnv_C :: (a->a->a) -> VarEnv a -> Var -> a -> VarEnv a
  326. extendVarEnv_Acc :: (a->b->b) -> (a->b) -> VarEnv b -> Var -> a -> VarEnv b
  327. plusVarEnv :: VarEnv a -> VarEnv a -> VarEnv a
  328. extendVarEnvList :: VarEnv a -> [(Var, a)] -> VarEnv a
  329. lookupVarEnv_Directly :: VarEnv a -> Unique -> Maybe a
  330. filterVarEnv_Directly :: (Unique -> a -> Bool) -> VarEnv a -> VarEnv a
  331. partitionVarEnv :: (a -> Bool) -> VarEnv a -> (VarEnv a, VarEnv a)
  332. restrictVarEnv :: VarEnv a -> VarSet -> VarEnv a
  333. delVarEnvList :: VarEnv a -> [Var] -> VarEnv a
  334. delVarEnv :: VarEnv a -> Var -> VarEnv a
  335. minusVarEnv :: VarEnv a -> VarEnv b -> VarEnv a
  336. intersectsVarEnv :: VarEnv a -> VarEnv a -> Bool
  337. plusVarEnv_C :: (a -> a -> a) -> VarEnv a -> VarEnv a -> VarEnv a
  338. mapVarEnv :: (a -> b) -> VarEnv a -> VarEnv b
  339. modifyVarEnv :: (a -> a) -> VarEnv a -> Var -> VarEnv a
  340. varEnvElts :: VarEnv a -> [a]
  341. varEnvKeys :: VarEnv a -> [Unique]
  342. isEmptyVarEnv :: VarEnv a -> Bool
  343. lookupVarEnv :: VarEnv a -> Var -> Maybe a
  344. lookupVarEnv_NF :: VarEnv a -> Var -> a
  345. lookupWithDefaultVarEnv :: VarEnv a -> a -> Var -> a
  346. elemVarEnv :: Var -> VarEnv a -> Bool
  347. elemVarEnvByKey :: Unique -> VarEnv a -> Bool
  348. foldVarEnv :: (a -> b -> b) -> b -> VarEnv a -> b
  349. \end{code}
  350. \begin{code}
  351. elemVarEnv = elemUFM
  352. elemVarEnvByKey = elemUFM_Directly
  353. alterVarEnv = alterUFM
  354. extendVarEnv = addToUFM
  355. extendVarEnv_C = addToUFM_C
  356. extendVarEnv_Acc = addToUFM_Acc
  357. extendVarEnvList = addListToUFM
  358. plusVarEnv_C = plusUFM_C
  359. delVarEnvList = delListFromUFM
  360. delVarEnv = delFromUFM
  361. minusVarEnv = minusUFM
  362. intersectsVarEnv e1 e2 = not (isEmptyVarEnv (e1 `intersectUFM` e2))
  363. plusVarEnv = plusUFM
  364. lookupVarEnv = lookupUFM
  365. lookupWithDefaultVarEnv = lookupWithDefaultUFM
  366. mapVarEnv = mapUFM
  367. mkVarEnv = listToUFM
  368. emptyVarEnv = emptyUFM
  369. varEnvElts = eltsUFM
  370. varEnvKeys = keysUFM
  371. unitVarEnv = unitUFM
  372. isEmptyVarEnv = isNullUFM
  373. foldVarEnv = foldUFM
  374. lookupVarEnv_Directly = lookupUFM_Directly
  375. filterVarEnv_Directly = filterUFM_Directly
  376. partitionVarEnv = partitionUFM
  377. restrictVarEnv env vs = filterVarEnv_Directly keep env
  378. where
  379. keep u _ = u `elemVarSetByKey` vs
  380. zipVarEnv tyvars tys = mkVarEnv (zipEqual "zipVarEnv" tyvars tys)
  381. lookupVarEnv_NF env id = case lookupVarEnv env id of
  382. Just xx -> xx
  383. Nothing -> panic "lookupVarEnv_NF: Nothing"
  384. \end{code}
  385. @modifyVarEnv@: Look up a thing in the VarEnv,
  386. then mash it with the modify function, and put it back.
  387. \begin{code}
  388. modifyVarEnv mangle_fn env key
  389. = case (lookupVarEnv env key) of
  390. Nothing -> env
  391. Just xx -> extendVarEnv env key (mangle_fn xx)
  392. modifyVarEnv_Directly :: (a -> a) -> UniqFM a -> Unique -> UniqFM a
  393. modifyVarEnv_Directly mangle_fn env key
  394. = case (lookupUFM_Directly env key) of
  395. Nothing -> env
  396. Just xx -> addToUFM_Directly env key (mangle_fn xx)
  397. \end{code}