Fix CodingStyle#Warnings URLs

[ghc-hetmet.git] / compiler / basicTypes / VarEnv.lhs

diff --git a/compiler/basicTypes/VarEnv.lhs b/compiler/basicTypes/VarEnv.lhs
index e59c800..f3a093a 100644 (file)
--- a/compiler/basicTypes/VarEnv.lhs
+++ b/compiler/basicTypes/VarEnv.lhs
@@ -1,9 +1,16 @@
-
+%
+% (c) The University of Glasgow 2006
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
-\section{@VarEnvs@: Variable environments}
 
 \begin{code}
+{-# OPTIONS -w #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and fix
+-- any warnings in the module. See
+--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
+-- for details
+
 module VarEnv (
        VarEnv, IdEnv, TyVarEnv,
        emptyVarEnv, unitVarEnv, mkVarEnv,
@@ -28,7 +35,7 @@ module VarEnv (
        -- RnEnv2 and its operations
        RnEnv2, mkRnEnv2, rnBndr2, rnBndrs2, rnOccL, rnOccR, inRnEnvL, inRnEnvR,
                rnBndrL, rnBndrR, nukeRnEnvL, nukeRnEnvR, extendRnInScopeList,
-               rnInScope, lookupRnInScope,
+               rnInScope, rnInScopeSet, lookupRnInScope,
 
        -- TidyEnvs
        TidyEnv, emptyTidyEnv
@@ -36,14 +43,14 @@ module VarEnv (
 
 #include "HsVersions.h"
 
-import OccName   ( TidyOccEnv, emptyTidyOccEnv )
-import Var       ( Var, setVarUnique )
+import OccName
+import Var
 import VarSet
 import UniqFM  
-import Unique    ( Unique, deriveUnique, getUnique )
-import Util      ( zipEqual, foldl2 )
-import Maybes    ( orElse )
-import StaticFlags( opt_PprStyle_Debug )
+import Unique
+import Util
+import Maybes
+import StaticFlags
 import Outputable
 import FastTypes
 \end{code}
@@ -196,6 +203,9 @@ extendRnInScopeList env vs
 rnInScope :: Var -> RnEnv2 -> Bool
 rnInScope x env = x `elemInScopeSet` in_scope env
 
+rnInScopeSet :: RnEnv2 -> InScopeSet
+rnInScopeSet = in_scope
+
 rnBndrs2 :: RnEnv2 -> [Var] -> [Var] -> RnEnv2
 -- Arg lists must be of equal length
 rnBndrs2 env bsL bsR = foldl2 rnBndr2 env bsL bsR 
@@ -226,21 +236,33 @@ rnBndr2 (RV2 { envL = envL, envR = envR, in_scope = in_scope }) bL bR
 rnBndrL, rnBndrR :: RnEnv2 -> Var -> (RnEnv2, Var)
 -- Used when there's a binder on one side or the other only
 -- Useful when eta-expanding
+-- 
 rnBndrL (RV2 { envL = envL, envR = envR, in_scope = in_scope }) bL
   = (RV2 { envL     = extendVarEnv envL bL new_b
-        , envR     = envR
+        , envR     = extendVarEnv envR new_b new_b     -- Note [rnBndrLR]
         , in_scope = extendInScopeSet in_scope new_b }, new_b)
   where
-    new_b | not (bL `elemInScopeSet` in_scope) = bL
-         | otherwise                          = uniqAway' in_scope bL
+    new_b = uniqAway in_scope bL
 
 rnBndrR (RV2 { envL = envL, envR = envR, in_scope = in_scope }) bR
-  = (RV2 { envL     = envL
+  = (RV2 { envL     = extendVarEnv envL new_b new_b    -- Note [rnBndrLR]
         , envR     = extendVarEnv envR bR new_b
         , in_scope = extendInScopeSet in_scope new_b }, new_b)
   where
-    new_b | not (bR `elemInScopeSet` in_scope) = bR
-         | otherwise                          = uniqAway' in_scope bR
+    new_b = uniqAway in_scope bR
+
+-- Note [rnBndrLR] 
+-- ~~~~~~~~~~~~~~~
+-- Notice that in rnBndrL, rnBndrR, we extend envR, envL respectively
+-- with a binding [new_b -> new_b], where new_b is the new binder.
+-- This is important when doing eta expansion; e.g. matching (\x.M) ~ N
+-- In effect we switch to (\x'.M) ~ (\x'.N x'), where x' is new_b
+-- So we must add x' to the env of both L and R.  (x' is fresh, so it
+-- can't capture anything in N.)  
+--
+-- If we don't do this, we can get silly matches like
+--     forall a.  \y.a  ~   v
+-- succeeding with [x -> v y], which is bogus of course 
 
 rnOccL, rnOccR :: RnEnv2 -> Var -> Var
 -- Look up the renaming of an occurrence in the left or right term