Whitespace in coreSyn/CoreFVs.lhs
authorIan Lynagh <igloo@earth.li>
Sun, 6 Nov 2011 20:34:40 +0000 (20:34 +0000)
committerIan Lynagh <igloo@earth.li>
Sun, 6 Nov 2011 20:34:40 +0000 (20:34 +0000)
compiler/coreSyn/CoreFVs.lhs

index 0c30e1e..a710cb0 100644 (file)
@@ -5,13 +5,6 @@
 Taken quite directly from the Peyton Jones/Lester paper.
 
 \begin{code}
-{-# OPTIONS -fno-warn-tabs #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and
--- detab the module (please do the detabbing in a separate patch). See
---     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
--- for details
-
 {-# OPTIONS -fno-warn-incomplete-patterns #-}
 -- The above warning supression flag is a temporary kludge.
 -- While working on this module you are encouraged to remove it and fix
@@ -32,11 +25,11 @@ module CoreFVs (
         exprSomeFreeVars, exprsSomeFreeVars,
 
         -- * Free variables of Rules, Vars and Ids
-        varTypeTyVars, varTypeTcTyVars, 
+        varTypeTyVars, varTypeTcTyVars,
         idUnfoldingVars, idFreeVars, idRuleAndUnfoldingVars,
         idRuleVars, idRuleRhsVars, stableUnfoldingVars,
         ruleRhsFreeVars, rulesFreeVars,
-        ruleLhsOrphNames, ruleLhsFreeIds, 
+        ruleLhsOrphNames, ruleLhsFreeIds,
         vectsFreeVars,
 
         -- * Core syntax tree annotation with free variables
@@ -66,16 +59,16 @@ import Outputable
 
 
 %************************************************************************
-%*                                                                     *
+%*                                                                      *
 \section{Finding the free variables of an expression}
-%*                                                                     *
+%*                                                                      *
 %************************************************************************
 
 This function simply finds the free variables of an expression.
 So far as type variables are concerned, it only finds tyvars that are
 
-       * free in type arguments, 
-       * free in the type of a binder,
+        * free in type arguments,
+        * free in the type of a binder,
 
 but not those that are free in the type of variable occurrence.
 
@@ -85,7 +78,7 @@ exprFreeVars :: CoreExpr -> VarSet
 exprFreeVars = exprSomeFreeVars isLocalVar
 
 -- | Find all locally-defined free Ids in an expression
-exprFreeIds :: CoreExpr -> IdSet       -- Find all locally-defined free Ids
+exprFreeIds :: CoreExpr -> IdSet        -- Find all locally-defined free Ids
 exprFreeIds = exprSomeFreeVars isLocalId
 
 -- | Find all locally-defined free Ids or type variables in several expressions
@@ -95,20 +88,20 @@ exprsFreeVars = foldr (unionVarSet . exprFreeVars) emptyVarSet
 -- | Find all locally defined free Ids in a binding group
 bindFreeVars :: CoreBind -> VarSet
 bindFreeVars (NonRec _ r) = exprFreeVars r
-bindFreeVars (Rec prs)    = addBndrs (map fst prs) 
-                                    (foldr (union . rhs_fvs) noVars prs)
-                                    isLocalVar emptyVarSet
+bindFreeVars (Rec prs)    = addBndrs (map fst prs)
+                                     (foldr (union . rhs_fvs) noVars prs)
+                                     isLocalVar emptyVarSet
 
 -- | Finds free variables in an expression selected by a predicate
-exprSomeFreeVars :: InterestingVarFun  -- ^ Says which 'Var's are interesting
-                -> CoreExpr
-                -> VarSet
+exprSomeFreeVars :: InterestingVarFun   -- ^ Says which 'Var's are interesting
+                 -> CoreExpr
+                 -> VarSet
 exprSomeFreeVars fv_cand e = expr_fvs e fv_cand emptyVarSet
 
 -- | Finds free variables in several expressions selected by a predicate
-exprsSomeFreeVars :: InterestingVarFun         -- Says which 'Var's are interesting
-                 -> [CoreExpr]
-                 -> VarSet
+exprsSomeFreeVars :: InterestingVarFun  -- Says which 'Var's are interesting
+                  -> [CoreExpr]
+                  -> VarSet
 exprsSomeFreeVars fv_cand = foldr (unionVarSet . exprSomeFreeVars fv_cand) emptyVarSet
 
 -- | Predicate on possible free variables: returns @True@ iff the variable is interesting
@@ -117,9 +110,9 @@ type InterestingVarFun = Var -> Bool
 
 
 \begin{code}
-type FV = InterestingVarFun 
-       -> VarSet               -- In scope
-       -> VarSet               -- Free vars
+type FV = InterestingVarFun
+        -> VarSet               -- In scope
+        -> VarSet               -- Free vars
 
 union :: FV -> FV -> FV
 union fv1 fv2 fv_cand in_scope = fv1 fv_cand in_scope `unionVarSet` fv2 fv_cand in_scope
@@ -127,7 +120,7 @@ union fv1 fv2 fv_cand in_scope = fv1 fv_cand in_scope `unionVarSet` fv2 fv_cand
 noVars :: FV
 noVars _ _ = emptyVarSet
 
---     Comment about obselete code
+--      Comment about obselete code
 -- We used to gather the free variables the RULES at a variable occurrence
 -- with the following cryptic comment:
 --     "At a variable occurrence, add in any free variables of its rule rhss
@@ -138,27 +131,27 @@ noVars _ _ = emptyVarSet
 --     a variable mentions itself one of its own rule RHSs"
 -- Not only is this "weird", but it's also pretty bad because it can make
 -- a function seem more recursive than it is.  Suppose
---     f  = ...g...
---     g  = ...
+--      f  = ...g...
+--      g  = ...
 --         RULE g x = ...f...
 -- Then f is not mentioned in its own RHS, and needn't be a loop breaker
 -- (though g may be).  But if we collect the rule fvs from g's occurrence,
 -- it looks as if f mentions itself.  (This bites in the eftInt/eftIntFB
 -- code in GHC.Enum.)
--- 
+--
 -- Anyway, it seems plain wrong.  The RULE is like an extra RHS for the
 -- function, so its free variables belong at the definition site.
 --
 -- Deleted code looked like
 --     foldVarSet add_rule_var var_itself_set (idRuleVars var)
 --     add_rule_var var set | keep_it fv_cand in_scope var = extendVarSet set var
---                         | otherwise                    = set
---     SLPJ Feb06
+--                          | otherwise                    = set
+--      SLPJ Feb06
 
 oneVar :: Id -> FV
 oneVar var fv_cand in_scope
-  = ASSERT( isId var ) 
-    if keep_it fv_cand in_scope var 
+  = ASSERT( isId var )
+    if keep_it fv_cand in_scope var
     then unitVarSet var
     else emptyVarSet
 
@@ -169,16 +162,16 @@ someVars vars fv_cand in_scope
 keep_it :: InterestingVarFun -> VarSet -> Var -> Bool
 keep_it fv_cand in_scope var
   | var `elemVarSet` in_scope = False
-  | fv_cand var                      = True
-  | otherwise                = False
+  | fv_cand var               = True
+  | otherwise                 = False
 
 
 addBndr :: CoreBndr -> FV -> FV
 addBndr bndr fv fv_cand in_scope
   = someVars (varTypeTyVars bndr) fv_cand in_scope
-       -- Include type varibles in the binder's type
-       --      (not just Ids; coercion variables too!)
-    `unionVarSet`  fv fv_cand (in_scope `extendVarSet` bndr) 
+        -- Include type varibles in the binder's type
+        --      (not just Ids; coercion variables too!)
+    `unionVarSet`  fv fv_cand (in_scope `extendVarSet` bndr)
 
 addBndrs :: [CoreBndr] -> FV -> FV
 addBndrs bndrs fv = foldr addBndr fv bndrs
@@ -188,9 +181,9 @@ addBndrs bndrs fv = foldr addBndr fv bndrs
 \begin{code}
 expr_fvs :: CoreExpr -> FV
 
-expr_fvs (Type ty)      = someVars (tyVarsOfType ty)
+expr_fvs (Type ty)       = someVars (tyVarsOfType ty)
 expr_fvs (Coercion co)   = someVars (tyCoVarsOfCo co)
-expr_fvs (Var var)      = oneVar var
+expr_fvs (Var var)       = oneVar var
 expr_fvs (Lit _)         = noVars
 expr_fvs (Tick t expr) = tickish_fvs t `union` expr_fvs expr
 expr_fvs (App fun arg)   = expr_fvs fun `union` expr_fvs arg
@@ -198,7 +191,7 @@ expr_fvs (Lam bndr body) = addBndr bndr (expr_fvs body)
 expr_fvs (Cast expr co)  = expr_fvs expr `union` someVars (tyCoVarsOfCo co)
 
 expr_fvs (Case scrut bndr ty alts)
-  = expr_fvs scrut `union` someVars (tyVarsOfType ty) `union` addBndr bndr  
+  = expr_fvs scrut `union` someVars (tyVarsOfType ty) `union` addBndr bndr
       (foldr (union . alt_fvs) noVars alts)
   where
     alt_fvs (_, bndrs, rhs) = addBndrs bndrs (expr_fvs rhs)
@@ -207,14 +200,14 @@ expr_fvs (Let (NonRec bndr rhs) body)
   = rhs_fvs (bndr, rhs) `union` addBndr bndr (expr_fvs body)
 
 expr_fvs (Let (Rec pairs) body)
-  = addBndrs (map fst pairs) 
-            (foldr (union . rhs_fvs) (expr_fvs body) pairs)
+  = addBndrs (map fst pairs)
+             (foldr (union . rhs_fvs) (expr_fvs body) pairs)
 
 ---------
 rhs_fvs :: (Id,CoreExpr) -> FV
-rhs_fvs (bndr, rhs) = expr_fvs rhs `union` 
+rhs_fvs (bndr, rhs) = expr_fvs rhs `union`
                       someVars (bndrRuleAndUnfoldingVars bndr)
-       -- Treat any RULES as extra RHSs of the binding
+        -- Treat any RULES as extra RHSs of the binding
 
 ---------
 exprs_fvs :: [CoreExpr] -> FV
@@ -227,16 +220,16 @@ tickish_fvs _ = noVars
 
 
 %************************************************************************
-%*                                                                     *
+%*                                                                      *
 \section{Free names}
-%*                                                                     *
+%*                                                                      *
 %************************************************************************
 
 \begin{code}
--- | ruleLhsOrphNames is used when deciding whether 
--- a rule is an orphan.  In particular, suppose that T is defined in this 
+-- | ruleLhsOrphNames is used when deciding whether
+-- a rule is an orphan.  In particular, suppose that T is defined in this
 -- module; we want to avoid declaring that a rule like:
--- 
+--
 -- > fromIntegral T = fromIntegral_T
 --
 -- is an orphan. Of course it isn't, and declaring it an orphan would
@@ -245,8 +238,8 @@ ruleLhsOrphNames :: CoreRule -> NameSet
 ruleLhsOrphNames (BuiltinRule { ru_fn = fn }) = unitNameSet fn
 ruleLhsOrphNames (Rule { ru_fn = fn, ru_args = tpl_args })
   = addOneToNameSet (exprsOrphNames tpl_args) fn
-               -- No need to delete bndrs, because
-               -- exprsOrphNames finds only External names
+                -- No need to delete bndrs, because
+                -- exprsOrphNames finds only External names
 
 -- | Finds the free /external/ names of an expression, notably
 -- including the names of type constructors (which of course do not show
@@ -257,15 +250,15 @@ exprOrphNames :: CoreExpr -> NameSet
 exprOrphNames e
   = go e
   where
-    go (Var v) 
+    go (Var v)
       | isExternalName n    = unitNameSet n
-      | otherwise          = emptyNameSet
+      | otherwise           = emptyNameSet
       where n = idName v
-    go (Lit _)                     = emptyNameSet
-    go (Type ty)           = orphNamesOfType ty        -- Don't need free tyvars
+    go (Lit _)              = emptyNameSet
+    go (Type ty)            = orphNamesOfType ty        -- Don't need free tyvars
     go (Coercion co)        = orphNamesOfCo co
-    go (App e1 e2)         = go e1 `unionNameSets` go e2
-    go (Lam v e)           = go e `delFromNameSet` idName v
+    go (App e1 e2)          = go e1 `unionNameSets` go e2
+    go (Lam v e)            = go e `delFromNameSet` idName v
     go (Tick _ e)         = go e
     go (Cast e co)          = go e `unionNameSets` orphNamesOfCo co
     go (Let (NonRec _ r) e) = go e `unionNameSets` go r
@@ -303,7 +296,7 @@ ruleFreeVars (Rule { ru_fn = _, ru_bndrs = bndrs, ru_rhs = rhs, ru_args = args }
 
 idRuleRhsVars :: (Activation -> Bool) -> Id -> VarSet
 -- Just the variables free on the *rhs* of a rule
-idRuleRhsVars is_active id 
+idRuleRhsVars is_active id
   = foldr (unionVarSet . get_fvs) emptyVarSet (idCoreRules id)
   where
     get_fvs (Rule { ru_fn = fn, ru_bndrs = bndrs
@@ -332,7 +325,7 @@ We used not to include the Id in its own rhs free-var set.
 Otherwise the occurrence analyser makes bindings recursive:
         f x y = x+y
         RULE:  f (f x y) z  ==>  f x (f y z)
-However, the occurrence analyser distinguishes "non-rule loop breakers" 
+However, the occurrence analyser distinguishes "non-rule loop breakers"
 from "rule-only loop breakers" (see BasicTypes.OccInfo).  So it will
 put this 'f' in a Rec block, but will mark the binding as a non-rule loop
 breaker, which is perfectly inlinable.
@@ -362,10 +355,10 @@ The free variable pass annotates every node in the expression with its
 NON-GLOBAL free variables and type variables.
 
 \begin{code}
--- | Every node in a binding group annotated with its 
+-- | Every node in a binding group annotated with its
 -- (non-global) free variables, both Ids and TyVars
 type CoreBindWithFVs = AnnBind Id VarSet
--- | Every node in an expression annotated with its 
+-- | Every node in an expression annotated with its
 -- (non-global) free variables, both Ids and TyVars
 type CoreExprWithFVs = AnnExpr Id VarSet
 
@@ -391,64 +384,64 @@ delBinderFV :: Var -> VarSet -> VarSet
 -- (b `delBinderFV` s) removes the binder b from the free variable set s,
 -- but *adds* to s
 --
---     the free variables of b's type
+--      the free variables of b's type
 --
 -- This is really important for some lambdas:
---     In (\x::a -> x) the only mention of "a" is in the binder.
+--      In (\x::a -> x) the only mention of "a" is in the binder.
 --
 -- Also in
---     let x::a = b in ...
+--      let x::a = b in ...
 -- we should really note that "a" is free in this expression.
 -- It'll be pinned inside the /\a by the binding for b, but
--- it seems cleaner to make sure that a is in the free-var set 
+-- it seems cleaner to make sure that a is in the free-var set
 -- when it is mentioned.
 --
 -- This also shows up in recursive bindings.  Consider:
---     /\a -> letrec x::a = x in E
+--      /\a -> letrec x::a = x in E
 -- Now, there are no explicit free type variables in the RHS of x,
 -- but nevertheless "a" is free in its definition.  So we add in
 -- the free tyvars of the types of the binders, and include these in the
 -- free vars of the group, attached to the top level of each RHS.
 --
 -- This actually happened in the defn of errorIO in IOBase.lhs:
---     errorIO (ST io) = case (errorIO# io) of
---                         _ -> bottom
---                       where
---                         bottom = bottom -- Never evaluated
+--      errorIO (ST io) = case (errorIO# io) of
+--                          _ -> bottom
+--                        where
+--                          bottom = bottom -- Never evaluated
 
 delBinderFV b s = (s `delVarSet` b) `unionFVs` varTypeTyVars b
-       -- Include coercion variables too!
+        -- Include coercion variables too!
 
 varTypeTyVars :: Var -> TyVarSet
 -- Find the type variables free in the type of the variable
 -- Remember, coercion variables can mention type variables...
 varTypeTyVars var
   | isLocalId var = tyVarsOfType (idType var)
-  | otherwise     = emptyVarSet        -- Global Ids and non-coercion TyVars
+  | otherwise     = emptyVarSet -- Global Ids and non-coercion TyVars
 
 varTypeTcTyVars :: Var -> TyVarSet
 -- Find the type variables free in the type of the variable
 -- Remember, coercion variables can mention type variables...
 varTypeTcTyVars var
   | isLocalId var = tcTyVarsOfType (idType var)
-  | otherwise     = emptyVarSet        -- Global Ids and non-coercion TyVars
+  | otherwise     = emptyVarSet -- Global Ids and non-coercion TyVars
 
 idFreeVars :: Id -> VarSet
 -- Type variables, rule variables, and inline variables
-idFreeVars id = ASSERT( isId id) 
-               varTypeTyVars id `unionVarSet`
-               idRuleAndUnfoldingVars id
+idFreeVars id = ASSERT( isId id)
+                varTypeTyVars id `unionVarSet`
+                idRuleAndUnfoldingVars id
 
 bndrRuleAndUnfoldingVars ::Var -> VarSet
--- A 'let' can bind a type variable, and idRuleVars assumes 
+-- A 'let' can bind a type variable, and idRuleVars assumes
 -- it's seeing an Id. This function tests first.
 bndrRuleAndUnfoldingVars v | isTyVar v = emptyVarSet
-                          | otherwise = idRuleAndUnfoldingVars v
+                           | otherwise = idRuleAndUnfoldingVars v
 
 idRuleAndUnfoldingVars :: Id -> VarSet
-idRuleAndUnfoldingVars id = ASSERT( isId id) 
-                           idRuleVars id    `unionVarSet` 
-                           idUnfoldingVars id
+idRuleAndUnfoldingVars id = ASSERT( isId id)
+                            idRuleVars id    `unionVarSet`
+                            idUnfoldingVars id
 
 idRuleVars ::Id -> VarSet  -- Does *not* include CoreUnfolding vars
 idRuleVars id = ASSERT( isId id) specInfoFreeVars (idSpecialisation id)
@@ -472,9 +465,9 @@ stableUnfoldingVars fv_cand unf
 
 
 %************************************************************************
-%*                                                                     *
+%*                                                                      *
 \subsection{Free variables (and types)}
-%*                                                                     *
+%*                                                                      *
 %************************************************************************
 
 \begin{code}
@@ -483,13 +476,13 @@ freeVars :: CoreExpr -> CoreExprWithFVs
 freeVars (Var v)
   = (fvs, AnnVar v)
   where
-       -- ToDo: insert motivating example for why we *need*
-       -- to include the idSpecVars in the FV list.
-       --      Actually [June 98] I don't think it's necessary
-       -- fvs = fvs_v `unionVarSet` idSpecVars v
+        -- ToDo: insert motivating example for why we *need*
+        -- to include the idSpecVars in the FV list.
+        --      Actually [June 98] I don't think it's necessary
+        -- fvs = fvs_v `unionVarSet` idSpecVars v
 
     fvs | isLocalVar v = aFreeVar v
-       | otherwise    = noFVs
+        | otherwise    = noFVs
 
 freeVars (Lit lit) = (noFVs, AnnLit lit)
 freeVars (Lam b body)
@@ -510,18 +503,18 @@ freeVars (Case scrut bndr ty alts)
     scrut2 = freeVars scrut
 
     (alts_fvs_s, alts2) = mapAndUnzip fv_alt alts
-    alts_fvs           = foldr1 unionFVs alts_fvs_s
+    alts_fvs            = foldr1 unionFVs alts_fvs_s
 
     fv_alt (con,args,rhs) = (delBindersFV args (freeVarsOf rhs2),
-                            (con, args, rhs2))
-                         where
-                            rhs2 = freeVars rhs
+                             (con, args, rhs2))
+                          where
+                             rhs2 = freeVars rhs
 
 freeVars (Let (NonRec binder rhs) body)
-  = (freeVarsOf rhs2 
-       `unionFVs` body_fvs 
+  = (freeVarsOf rhs2
+       `unionFVs` body_fvs
        `unionFVs` bndrRuleAndUnfoldingVars binder,
-               -- Remember any rules; cf rhs_fvs above
+                -- Remember any rules; cf rhs_fvs above
      AnnLet (AnnNonRec binder rhs2) body2)
   where
     rhs2     = freeVars rhs
@@ -537,8 +530,8 @@ freeVars (Let (Rec binds) body)
     rhss2     = map freeVars rhss
     rhs_body_fvs = foldr (unionFVs . freeVarsOf) body_fvs rhss2
     all_fvs      = foldr (unionFVs . idRuleAndUnfoldingVars) rhs_body_fvs binders
-       -- The "delBinderFV" happens after adding the idSpecVars,
-       -- since the latter may add some of the binders as fvs
+        -- The "delBinderFV" happens after adding the idSpecVars,
+        -- since the latter may add some of the binders as fvs
 
     body2     = freeVars body
     body_fvs  = freeVarsOf body2