simplCore: detabify/dewhitespace LiberateCase

Signed-off-by: Austin Seipp <austin@well-typed.com>

1 files changed, 120 insertions, 128 deletions

diff --git a/compiler/simplCore/LiberateCase.lhs b/compiler/simplCore/LiberateCase.lhs
index 2593ab159c..21adf20f44 100644
--- a/compiler/simplCore/LiberateCase.lhs
+++ b/compiler/simplCore/LiberateCase.lhs
@@ -5,20 +5,13 @@
 
 \begin{code}
 {-# LANGUAGE CPP #-}
-{-# OPTIONS_GHC -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://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
--- for details
-
 module LiberateCase ( liberateCase ) where
 
 #include "HsVersions.h"
 
 import DynFlags
 import CoreSyn
-import CoreUnfold	( couldBeSmallEnoughToInline )
+import CoreUnfold       ( couldBeSmallEnoughToInline )
 import Id
 import VarEnv
 import Util             ( notNull )
@@ -28,29 +21,29 @@ The liberate-case transformation
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 This module walks over @Core@, and looks for @case@ on free variables.
 The criterion is:
-	if there is case on a free on the route to the recursive call,
-	then the recursive call is replaced with an unfolding.
+        if there is case on a free on the route to the recursive call,
+        then the recursive call is replaced with an unfolding.
 
 Example
 
    f = \ t -> case v of
-	         V a b -> a : f t
+                 V a b -> a : f t
 
 => the inner f is replaced.
 
    f = \ t -> case v of
-	         V a b -> a : (letrec
-				f =  \ t -> case v of
-					       V a b -> a : f t
-			       in f) t
+                 V a b -> a : (letrec
+                                f =  \ t -> case v of
+                                               V a b -> a : f t
+                               in f) t
 (note the NEED for shadowing)
 
 => Simplify
 
   f = \ t -> case v of
-	         V a b -> a : (letrec
-				f = \ t -> a : f t
-			       in f t)
+                 V a b -> a : (letrec
+                                f = \ t -> a : f t
+                               in f t)
 
 Better code, because 'a' is  free inside the inner letrec, rather
 than needing projection from v.
@@ -58,18 +51,18 @@ than needing projection from v.
 Note that this deals with *free variables*.  SpecConstr deals with
 *arguments* that are of known form.  E.g.
 
-	last []     = error 
-	last (x:[]) = x
-	last (x:xs) = last xs
+        last []     = error
+        last (x:[]) = x
+        last (x:xs) = last xs
+
 
-	
 Note [Scrutinee with cast]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~
 Consider this:
     f = \ t -> case (v `cast` co) of
-	         V a b -> a : f t
+                 V a b -> a : f t
 
-Exactly the same optimisation (unrolling one call to f) will work here, 
+Exactly the same optimisation (unrolling one call to f) will work here,
 despite the cast.  See mk_alt_env in the Case branch of libCase.
 
 
@@ -109,19 +102,19 @@ recursive defns lexically enclose the binding
 A recursive defn "encloses" its RHS, not its
 scope.  For example:
 \begin{verbatim}
-	letrec f = let g = ... in ...
-	in
-	let h = ...
-	in ...
+        letrec f = let g = ... in ...
+        in
+        let h = ...
+        in ...
 \end{verbatim}
 Here, the level of @f@ is zero, the level of @g@ is one,
 and the level of @h@ is zero (NB not one).
 
 
 %************************************************************************
-%*									*
-	 Top-level code
-%*									*
+%*                                                                      *
+         Top-level code
+%*                                                                      *
 %************************************************************************
 
 \begin{code}
@@ -130,15 +123,15 @@ liberateCase dflags binds = do_prog (initEnv dflags) binds
   where
     do_prog _   [] = []
     do_prog env (bind:binds) = bind' : do_prog env' binds
-			     where
-			       (env', bind') = libCaseBind env bind
+                             where
+                               (env', bind') = libCaseBind env bind
 \end{code}
 
 
 %************************************************************************
-%*									*
-	 Main payload
-%*									*
+%*                                                                      *
+         Main payload
+%*                                                                      *
 %************************************************************************
 
 Bindings
@@ -158,18 +151,18 @@ libCaseBind env (Rec pairs)
 
     pairs' = [(binder, libCase env_rhs rhs) | (binder,rhs) <- pairs]
 
-	-- We extend the rec-env by binding each Id to its rhs, first
-	-- processing the rhs with an *un-extended* environment, so
-	-- that the same process doesn't occur for ever!
+        -- We extend the rec-env by binding each Id to its rhs, first
+        -- processing the rhs with an *un-extended* environment, so
+        -- that the same process doesn't occur for ever!
     env_rhs = addRecBinds env [ (localiseId binder, libCase env_body rhs)
-			      | (binder, rhs) <- pairs
- 			      , rhs_small_enough binder rhs ]
-	-- localiseID : see Note [Need to localiseId in libCaseBind]
-		 
-
-    rhs_small_enough id rhs	-- Note [Small enough]
-	=  idArity id > 0	-- Note [Only functions!]
-	&& maybe True (\size -> couldBeSmallEnoughToInline (lc_dflags env) size rhs)
+                              | (binder, rhs) <- pairs
+                              , rhs_small_enough binder rhs ]
+        -- localiseID : see Note [Need to localiseId in libCaseBind]
+
+
+    rhs_small_enough id rhs     -- Note [Small enough]
+        =  idArity id > 0       -- Note [Only functions!]
+        && maybe True (\size -> couldBeSmallEnoughToInline (lc_dflags env) size rhs)
                       (bombOutSize env)
 \end{code}
 
@@ -177,21 +170,21 @@ Note [Need to localiseId in libCaseBind]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 The call to localiseId is needed for two subtle reasons
 (a)  Reset the export flags on the binders so
-	that we don't get name clashes on exported things if the 
-	local binding floats out to top level.  This is most unlikely
-	to happen, since the whole point concerns free variables. 
-	But resetting the export flag is right regardless.
+        that we don't get name clashes on exported things if the
+        local binding floats out to top level.  This is most unlikely
+        to happen, since the whole point concerns free variables.
+        But resetting the export flag is right regardless.
 
 (b)  Make the name an Internal one.  External Names should never be
-	nested; if it were floated to the top level, we'd get a name
-	clash at code generation time.
+        nested; if it were floated to the top level, we'd get a name
+        clash at code generation time.
 
 Note [Small enough]
 ~~~~~~~~~~~~~~~~~~~
 Consider
   \fv. letrec
-     	 f = \x. BIG...(case fv of { (a,b) -> ...g.. })...
-     	 g = \y. SMALL...f...
+         f = \x. BIG...(case fv of { (a,b) -> ...g.. })...
+         g = \y. SMALL...f...
 Then we *can* do liberate-case on g (small RHS) but not for f (too big).
 But we can choose on a item-by-item basis, and that's what the
 rhs_small_enough call in the comprehension for env_rhs does.
@@ -201,8 +194,8 @@ Expressions
 
 \begin{code}
 libCase :: LibCaseEnv
-	-> CoreExpr
-	-> CoreExpr
+        -> CoreExpr
+        -> CoreExpr
 
 libCase env (Var v)             = libCaseId env v
 libCase _   (Lit lit)           = Lit lit
@@ -225,8 +218,8 @@ libCase env (Case scrut bndr ty alts)
   where
     env_alts = addBinders (mk_alt_env scrut) [bndr]
     mk_alt_env (Var scrut_var) = addScrutedVar env scrut_var
-    mk_alt_env (Cast scrut _)  = mk_alt_env scrut	-- Note [Scrutinee with cast]
-    mk_alt_env _    	       = env
+    mk_alt_env (Cast scrut _)  = mk_alt_env scrut       -- Note [Scrutinee with cast]
+    mk_alt_env _               = env
 
 libCaseAlt :: LibCaseEnv -> (AltCon, [CoreBndr], CoreExpr)
                          -> (AltCon, [CoreBndr], CoreExpr)
@@ -239,8 +232,8 @@ Ids
 \begin{code}
 libCaseId :: LibCaseEnv -> Id -> CoreExpr
 libCaseId env v
-  | Just the_bind <- lookupRecId env v	-- It's a use of a recursive thing
-  , notNull free_scruts 		-- with free vars scrutinised in RHS
+  | Just the_bind <- lookupRecId env v  -- It's a use of a recursive thing
+  , notNull free_scruts                 -- with free vars scrutinised in RHS
   = Let the_bind (Var v)
 
   | otherwise
@@ -251,34 +244,34 @@ libCaseId env v
     free_scruts  = freeScruts env rec_id_level
 
 freeScruts :: LibCaseEnv
-	   -> LibCaseLevel 	-- Level of the recursive Id
-	   -> [Id]		-- Ids that are scrutinised between the binding
-				-- of the recursive Id and here
+           -> LibCaseLevel      -- Level of the recursive Id
+           -> [Id]              -- Ids that are scrutinised between the binding
+                                -- of the recursive Id and here
 freeScruts env rec_bind_lvl
   = [v | (v, scrut_bind_lvl, scrut_at_lvl) <- lc_scruts env
        , scrut_bind_lvl <= rec_bind_lvl
        , scrut_at_lvl > rec_bind_lvl]
-	-- Note [When to specialise]
-	-- Note [Avoiding fruitless liberate-case]
+        -- Note [When to specialise]
+        -- Note [Avoiding fruitless liberate-case]
 \end{code}
 
 Note [When to specialise]
 ~~~~~~~~~~~~~~~~~~~~~~~~~
 Consider
   f = \x. letrec g = \y. case x of
-			   True  -> ... (f a) ...
-			   False -> ... (g b) ...
+                           True  -> ... (f a) ...
+                           False -> ... (g b) ...
 
 We get the following levels
-	  f  0
-	  x  1
-	  g  1
-	  y  2  
+          f  0
+          x  1
+          g  1
+          y  2
 
 Then 'x' is being scrutinised at a deeper level than its binding, so
-it's added to lc_sruts:  [(x,1)]  
+it's added to lc_sruts:  [(x,1)]
 
-We do *not* want to specialise the call to 'f', because 'x' is not free 
+We do *not* want to specialise the call to 'f', because 'x' is not free
 in 'f'.  So here the bind-level of 'x' (=1) is not <= the bind-level of 'f' (=0).
 
 We *do* want to specialise the call to 'g', because 'x' is free in g.
@@ -302,9 +295,9 @@ an occurrence of 'g', we want to check that there's a scruted-var v st
 
 
 %************************************************************************
-%*									*
-	Utility functions
-%*									*
+%*                                                                      *
+        Utility functions
+%*                                                                      *
 %************************************************************************
 
 \begin{code}
@@ -315,8 +308,8 @@ addBinders env@(LibCaseEnv { lc_lvl = lvl, lc_lvl_env = lvl_env }) binders
     lvl_env' = extendVarEnvList lvl_env (binders `zip` repeat lvl)
 
 addRecBinds :: LibCaseEnv -> [(Id,CoreExpr)] -> LibCaseEnv
-addRecBinds env@(LibCaseEnv {lc_lvl = lvl, lc_lvl_env = lvl_env, 
-			     lc_rec_env = rec_env}) pairs
+addRecBinds env@(LibCaseEnv {lc_lvl = lvl, lc_lvl_env = lvl_env,
+                             lc_rec_env = rec_env}) pairs
   = env { lc_lvl = lvl', lc_lvl_env = lvl_env', lc_rec_env = rec_env' }
   where
     lvl'     = lvl + 1
@@ -324,22 +317,22 @@ addRecBinds env@(LibCaseEnv {lc_lvl = lvl, lc_lvl_env = lvl_env,
     rec_env' = extendVarEnvList rec_env [(binder, Rec pairs) | (binder,_) <- pairs]
 
 addScrutedVar :: LibCaseEnv
-	      -> Id		-- This Id is being scrutinised by a case expression
-	      -> LibCaseEnv
+              -> Id             -- This Id is being scrutinised by a case expression
+              -> LibCaseEnv
 
-addScrutedVar env@(LibCaseEnv { lc_lvl = lvl, lc_lvl_env = lvl_env, 
-				lc_scruts = scruts }) scrut_var
+addScrutedVar env@(LibCaseEnv { lc_lvl = lvl, lc_lvl_env = lvl_env,
+                                lc_scruts = scruts }) scrut_var
   | bind_lvl < lvl
   = env { lc_scruts = scruts' }
-	-- Add to scruts iff the scrut_var is being scrutinised at
-	-- a deeper level than its defn
+        -- Add to scruts iff the scrut_var is being scrutinised at
+        -- a deeper level than its defn
 
   | otherwise = env
   where
     scruts'  = (scrut_var, bind_lvl, lvl) : scruts
     bind_lvl = case lookupVarEnv lvl_env scrut_var of
-		 Just lvl -> lvl
-		 Nothing  -> topLevel
+                 Just lvl -> lvl
+                 Nothing  -> topLevel
 
 lookupRecId :: LibCaseEnv -> Id -> Maybe CoreBind
 lookupRecId env id = lookupVarEnv (lc_rec_env env) id
@@ -352,9 +345,9 @@ lookupLevel env id
 \end{code}
 
 %************************************************************************
-%*									*
-	 The environment
-%*									*
+%*                                                                      *
+         The environment
+%*                                                                      *
 %************************************************************************
 
 \begin{code}
@@ -369,46 +362,46 @@ data LibCaseEnv
   = LibCaseEnv {
         lc_dflags :: DynFlags,
 
-	lc_lvl :: LibCaseLevel,	-- Current level
-		-- The level is incremented when (and only when) going
-		-- inside the RHS of a (sufficiently small) recursive
-		-- function.
-
-	lc_lvl_env :: IdEnv LibCaseLevel,  
-		-- Binds all non-top-level in-scope Ids (top-level and
-		-- imported things have a level of zero)
-
-	lc_rec_env :: IdEnv CoreBind, 
-		-- Binds *only* recursively defined ids, to their own
-		-- binding group, and *only* in their own RHSs
-
-	lc_scruts :: [(Id, LibCaseLevel, LibCaseLevel)]
-     		-- Each of these Ids was scrutinised by an enclosing
-		-- case expression, at a level deeper than its binding
-		-- level.
-		-- 
- 		-- The first LibCaseLevel is the *binding level* of
- 		--   the scrutinised Id, 
-		-- The second is the level *at which it was scrutinised*.
-		--   (see Note [Avoiding fruitless liberate-case])
-		-- The former is a bit redundant, since you could always
-		-- look it up in lc_lvl_env, but it's just cached here
-		-- 
-		-- The order is insignificant; it's a bag really
-		-- 
-		-- There's one element per scrutinisation;
-		--    in principle the same Id may appear multiple times,
-		--    although that'd be unusual:
-		--       case x of { (a,b) -> ....(case x of ...) .. }
-	}
+        lc_lvl :: LibCaseLevel, -- Current level
+                -- The level is incremented when (and only when) going
+                -- inside the RHS of a (sufficiently small) recursive
+                -- function.
+
+        lc_lvl_env :: IdEnv LibCaseLevel,
+                -- Binds all non-top-level in-scope Ids (top-level and
+                -- imported things have a level of zero)
+
+        lc_rec_env :: IdEnv CoreBind,
+                -- Binds *only* recursively defined ids, to their own
+                -- binding group, and *only* in their own RHSs
+
+        lc_scruts :: [(Id, LibCaseLevel, LibCaseLevel)]
+                -- Each of these Ids was scrutinised by an enclosing
+                -- case expression, at a level deeper than its binding
+                -- level.
+                --
+                -- The first LibCaseLevel is the *binding level* of
+                --   the scrutinised Id,
+                -- The second is the level *at which it was scrutinised*.
+                --   (see Note [Avoiding fruitless liberate-case])
+                -- The former is a bit redundant, since you could always
+                -- look it up in lc_lvl_env, but it's just cached here
+                --
+                -- The order is insignificant; it's a bag really
+                --
+                -- There's one element per scrutinisation;
+                --    in principle the same Id may appear multiple times,
+                --    although that'd be unusual:
+                --       case x of { (a,b) -> ....(case x of ...) .. }
+        }
 
 initEnv :: DynFlags -> LibCaseEnv
-initEnv dflags 
+initEnv dflags
   = LibCaseEnv { lc_dflags = dflags,
-		 lc_lvl = 0,
-		 lc_lvl_env = emptyVarEnv, 
-		 lc_rec_env = emptyVarEnv,
-		 lc_scruts = [] }
+                 lc_lvl = 0,
+                 lc_lvl_env = emptyVarEnv,
+                 lc_rec_env = emptyVarEnv,
+                 lc_scruts = [] }
 
 -- Bomb-out size for deciding if
 -- potential liberatees are too big.
@@ -416,4 +409,3 @@ initEnv dflags
 bombOutSize :: LibCaseEnv -> Maybe Int
 bombOutSize = liberateCaseThreshold . lc_dflags
 \end{code}
-