Fix whitespace in coreSyn/PprCore.lhs

1 files changed, 112 insertions, 119 deletions

diff --git a/compiler/coreSyn/PprCore.lhs b/compiler/coreSyn/PprCore.lhs
index 9504b14ee5..be2948eb3f 100644
--- a/compiler/coreSyn/PprCore.lhs
+++ b/compiler/coreSyn/PprCore.lhs
@@ -6,17 +6,10 @@
 Printing of Core syntax
 
 \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
-
 module PprCore (
-	pprCoreExpr, pprParendExpr,
-	pprCoreBinding, pprCoreBindings, pprCoreAlt,
-	pprRules
+        pprCoreExpr, pprParendExpr,
+        pprCoreBinding, pprCoreBindings, pprCoreAlt,
+        pprRules
     ) where
 
 import CoreSyn
@@ -39,9 +32,9 @@ import Data.Maybe
 \end{code}
 
 %************************************************************************
-%*									*
+%*                                                                      *
 \subsection{Public interfaces for Core printing (excluding instances)}
-%*									*
+%*                                                                      *
 %************************************************************************
 
 @pprParendCoreExpr@ puts parens around non-atomic Core expressions.
@@ -53,7 +46,7 @@ pprCoreExpr     :: OutputableBndr b => Expr b  -> SDoc
 pprParendExpr   :: OutputableBndr b => Expr b  -> SDoc
 
 pprCoreBindings = pprTopBinds
-pprCoreBinding  = pprTopBind 
+pprCoreBinding  = pprTopBind
 
 instance OutputableBndr b => Outputable (Bind b) where
     ppr bind = ppr_bind bind
@@ -64,9 +57,9 @@ instance OutputableBndr b => Outputable (Expr b) where
 
 
 %************************************************************************
-%*									*
+%*                                                                      *
 \subsection{The guts}
-%*									*
+%*                                                                      *
 %************************************************************************
 
 \begin{code}
@@ -81,23 +74,23 @@ pprTopBind (Rec [])
   = ptext (sLit "Rec { }")
 pprTopBind (Rec (b:bs))
   = vcat [ptext (sLit "Rec {"),
-	  ppr_binding b,
-	  vcat [blankLine $$ ppr_binding b | b <- bs],
-	  ptext (sLit "end Rec }"),
-	  blankLine]
+          ppr_binding b,
+          vcat [blankLine $$ ppr_binding b | b <- bs],
+          ptext (sLit "end Rec }"),
+          blankLine]
 \end{code}
 
 \begin{code}
 ppr_bind :: OutputableBndr b => Bind b -> SDoc
 
 ppr_bind (NonRec val_bdr expr) = ppr_binding (val_bdr, expr)
-ppr_bind (Rec binds)  	       = vcat (map pp binds)
-			       where
-				 pp bind = ppr_binding bind <> semi
+ppr_bind (Rec binds)           = vcat (map pp binds)
+                               where
+                                 pp bind = ppr_binding bind <> semi
 
 ppr_binding :: OutputableBndr b => (b, Expr b) -> SDoc
 ppr_binding (val_bdr, expr)
-  = pprBndr LetBind val_bdr $$ 
+  = pprBndr LetBind val_bdr $$
     hang (ppr val_bdr <+> equals) 2 (pprCoreExpr expr)
 \end{code}
 
@@ -111,79 +104,79 @@ noParens pp = pp
 
 \begin{code}
 ppr_expr :: OutputableBndr b => (SDoc -> SDoc) -> Expr b -> SDoc
-	-- The function adds parens in context that need
-	-- an atomic value (e.g. function args)
+        -- The function adds parens in context that need
+        -- an atomic value (e.g. function args)
 
 ppr_expr _       (Var name)    = ppr name
-ppr_expr add_par (Type ty)     = add_par (ptext (sLit "TYPE") <+> ppr ty)	-- Wierd
+ppr_expr add_par (Type ty)     = add_par (ptext (sLit "TYPE") <+> ppr ty)       -- Wierd
 ppr_expr add_par (Coercion co) = add_par (ptext (sLit "CO") <+> ppr co)
 ppr_expr add_par (Lit lit)     = pprLiteral add_par lit
 
-ppr_expr add_par (Cast expr co) 
+ppr_expr add_par (Cast expr co)
   = add_par $
-    sep [pprParendExpr expr, 
-	 ptext (sLit "`cast`") <+> pprCo co]
+    sep [pprParendExpr expr,
+         ptext (sLit "`cast`") <+> pprCo co]
   where
     pprCo co | opt_SuppressCoercions = ptext (sLit "...")
              | otherwise = parens
                          $ sep [ppr co, dcolon <+> pprEqPred (coercionKind co)]
-	 
+
 
 ppr_expr add_par expr@(Lam _ _)
   = let
-	(bndrs, body) = collectBinders expr
+        (bndrs, body) = collectBinders expr
     in
     add_par $
     hang (ptext (sLit "\\") <+> sep (map (pprBndr LambdaBind) bndrs) <+> arrow)
-	 2 (pprCoreExpr body)
+         2 (pprCoreExpr body)
 
 ppr_expr add_par expr@(App {})
-  = case collectArgs expr of { (fun, args) -> 
+  = case collectArgs expr of { (fun, args) ->
     let
-	pp_args     = sep (map pprArg args)
-	val_args    = dropWhile isTypeArg args	 -- Drop the type arguments for tuples
-	pp_tup_args = sep (punctuate comma (map pprCoreExpr val_args))
+        pp_args     = sep (map pprArg args)
+        val_args    = dropWhile isTypeArg args   -- Drop the type arguments for tuples
+        pp_tup_args = sep (punctuate comma (map pprCoreExpr val_args))
     in
     case fun of
-	Var f -> case isDataConWorkId_maybe f of
-			-- Notice that we print the *worker*
-			-- for tuples in paren'd format.
-		   Just dc | saturated && isTupleTyCon tc
-			   -> tupleParens (tupleTyConSort tc) pp_tup_args
-			   where
-			     tc	       = dataConTyCon dc
-			     saturated = val_args `lengthIs` idArity f
-
-		   _ -> add_par (hang (ppr f) 2 pp_args)
-
-	_ -> add_par (hang (pprParendExpr fun) 2 pp_args)
+        Var f -> case isDataConWorkId_maybe f of
+                        -- Notice that we print the *worker*
+                        -- for tuples in paren'd format.
+                   Just dc | saturated && isTupleTyCon tc
+                           -> tupleParens (tupleTyConSort tc) pp_tup_args
+                           where
+                             tc        = dataConTyCon dc
+                             saturated = val_args `lengthIs` idArity f
+
+                   _ -> add_par (hang (ppr f) 2 pp_args)
+
+        _ -> add_par (hang (pprParendExpr fun) 2 pp_args)
     }
 
 ppr_expr add_par (Case expr var ty [(con,args,rhs)])
   | opt_PprCaseAsLet
   = add_par $
-    sep [sep 	[ ptext (sLit "let")
-			<+> char '{'
-			<+> ppr_case_pat con args 
-			<+> ptext (sLit "~")
-			<+> ppr_bndr var
-		, ptext (sLit "<-") 
-		  	<+> ppr_expr id expr
-		, char '}' 
-			<+> ptext (sLit "in")
-	  	]
-	, pprCoreExpr rhs
-    	]
+    sep [sep    [ ptext (sLit "let")
+                        <+> char '{'
+                        <+> ppr_case_pat con args
+                        <+> ptext (sLit "~")
+                        <+> ppr_bndr var
+                , ptext (sLit "<-")
+                        <+> ppr_expr id expr
+                , char '}'
+                        <+> ptext (sLit "in")
+                ]
+        , pprCoreExpr rhs
+        ]
 
   | otherwise
   = add_par $
     sep [sep [ptext (sLit "case") <+> pprCoreExpr expr,
-	      ifPprDebug (braces (ppr ty)),
-	      sep [ptext (sLit "of") <+> ppr_bndr var, 
-		   char '{' <+> ppr_case_pat con args <+> arrow]
-	  ],
-	 pprCoreExpr rhs,
-	 char '}'
+              ifPprDebug (braces (ppr ty)),
+              sep [ptext (sLit "of") <+> ppr_bndr var,
+                   char '{' <+> ppr_case_pat con args <+> arrow]
+          ],
+         pprCoreExpr rhs,
+         char '}'
     ]
   where
     ppr_bndr = pprBndr CaseBind
@@ -191,15 +184,15 @@ ppr_expr add_par (Case expr var ty [(con,args,rhs)])
 ppr_expr add_par (Case expr var ty alts)
   = add_par $
     sep [sep [ptext (sLit "case")
-		<+> pprCoreExpr expr
-		<+> ifPprDebug (braces (ppr ty)),
-	      ptext (sLit "of") <+> ppr_bndr var <+> char '{'],
-	 nest 2 (vcat (punctuate semi (map pprCoreAlt alts))),
-	 char '}'
+                <+> pprCoreExpr expr
+                <+> ifPprDebug (braces (ppr ty)),
+              ptext (sLit "of") <+> ppr_bndr var <+> char '{'],
+         nest 2 (vcat (punctuate semi (map pprCoreAlt alts))),
+         char '}'
     ]
   where
     ppr_bndr = pprBndr CaseBind
- 
+
 
 -- special cases: let ... in let ...
 -- ("disgusting" SLPJ)
@@ -216,8 +209,8 @@ ppr_expr add_par (Let bind@(NonRec val_bdr rhs@(Let _ _)) body)
 ppr_expr add_par (Let bind@(NonRec val_bdr rhs) expr@(Let _ _))
   = add_par
     (hang (ptext (sLit "let {"))
-	  2 (hsep [ppr_binding (val_bdr,rhs),
-		   ptext (sLit "} in")])
+          2 (hsep [ppr_binding (val_bdr,rhs),
+                   ptext (sLit "} in")])
      $$
      pprCoreExpr expr)
 -}
@@ -226,17 +219,17 @@ ppr_expr add_par (Let bind@(NonRec val_bdr rhs) expr@(Let _ _))
 ppr_expr add_par (Let bind expr)
   = add_par $
     sep [hang (ptext keyword) 2 (ppr_bind bind <+> ptext (sLit "} in")),
-	 pprCoreExpr expr]
+         pprCoreExpr expr]
   where
     keyword = case bind of
-		Rec _      -> (sLit "letrec {")
-		NonRec _ _ -> (sLit "let {")
+                Rec _      -> (sLit "letrec {")
+                NonRec _ _ -> (sLit "let {")
 
 ppr_expr add_par (Tick tickish expr)
   = add_par (sep [ppr tickish, pprCoreExpr expr])
 
 pprCoreAlt :: OutputableBndr a => (AltCon, [a] , Expr a) -> SDoc
-pprCoreAlt (con, args, rhs) 
+pprCoreAlt (con, args, rhs)
   = hang (ppr_case_pat con args <+> arrow) 2 (pprCoreExpr rhs)
 
 ppr_case_pat :: OutputableBndr a => AltCon -> [a] -> SDoc
@@ -255,9 +248,9 @@ ppr_case_pat con args
 
 -- | Pretty print the argument in a function application.
 pprArg :: OutputableBndr a => Expr a -> SDoc
-pprArg (Type ty) 
- | opt_SuppressTypeApplications	= empty
- | otherwise			= ptext (sLit "@") <+> pprParendType ty
+pprArg (Type ty)
+ | opt_SuppressTypeApplications = empty
+ | otherwise                    = ptext (sLit "@") <+> pprParendType ty
 pprArg (Coercion co) = ptext (sLit "@~") <+> pprParendCo co
 pprArg expr          = pprParendExpr expr
 \end{code}
@@ -274,17 +267,17 @@ instance OutputableBndr Var where
 pprCoreBinder :: BindingSite -> Var -> SDoc
 pprCoreBinder LetBind binder
   | isTyVar binder = pprKindedTyVarBndr binder
-  | otherwise      = pprTypedLetBinder binder $$ 
-		     ppIdInfo binder (idInfo binder)
+  | otherwise      = pprTypedLetBinder binder $$
+                     ppIdInfo binder (idInfo binder)
 
 -- Lambda bound type variables are preceded by "@"
-pprCoreBinder bind_site bndr 
+pprCoreBinder bind_site bndr
   = getPprStyle $ \ sty ->
     pprTypedLamBinder bind_site (debugStyle sty) bndr
 
 pprUntypedBinder :: Var -> SDoc
 pprUntypedBinder binder
-  | isTyVar binder = ptext (sLit "@") <+> ppr binder	-- NB: don't print kind
+  | isTyVar binder = ptext (sLit "@") <+> ppr binder    -- NB: don't print kind
   | otherwise      = pprIdBndr binder
 
 pprTypedLamBinder :: BindingSite -> Bool -> Var -> SDoc
@@ -294,7 +287,7 @@ pprTypedLamBinder bind_site debug_on var
   | not debug_on, CaseBind <- bind_site = pprUntypedBinder var  -- No parens, no kind info
   | opt_SuppressAll                     = pprUntypedBinder var  -- Suppress the signature
   | isTyVar var                         = parens (pprKindedTyVarBndr var)
-  | otherwise = parens (hang (pprIdBndr var) 
+  | otherwise = parens (hang (pprIdBndr var)
                            2 (vcat [ dcolon <+> pprType (idType var), pp_unf]))
   where
     unf_info = unfoldingInfo (idInfo var)
@@ -304,9 +297,9 @@ pprTypedLamBinder bind_site debug_on var
 pprTypedLetBinder :: Var -> SDoc
 -- Print binder with a type or kind signature (not paren'd)
 pprTypedLetBinder binder
-  | isTyVar binder	       = pprKindedTyVarBndr binder
+  | isTyVar binder             = pprKindedTyVarBndr binder
   | opt_SuppressTypeSignatures = pprIdBndr binder
-  | otherwise		       = hang (pprIdBndr binder) 2 (dcolon <+> pprType (idType binder))
+  | otherwise                  = hang (pprIdBndr binder) 2 (dcolon <+> pprType (idType binder))
 
 pprKindedTyVarBndr :: TyVar -> SDoc
 -- Print a type variable binder with its kind (but not if *)
@@ -319,7 +312,7 @@ pprIdBndr :: Id -> SDoc
 pprIdBndr id = ppr id <+> pprIdBndrInfo (idInfo id)
 
 pprIdBndrInfo :: IdInfo -> SDoc
-pprIdBndrInfo info 
+pprIdBndrInfo info
   | opt_SuppressIdInfo = empty
   | otherwise
   = megaSeqIdInfo info `seq` doc -- The seq is useful for poking on black holes
@@ -334,23 +327,23 @@ pprIdBndrInfo info
     has_dmd  = case dmd_info of { Nothing -> False; Just d -> not (isTop d) }
     has_lbv  = not (hasNoLBVarInfo lbv_info)
 
-    doc = showAttributes 
-	  [ (has_prag, ptext (sLit "InlPrag=") <> ppr prag_info)
-	  , (has_occ,  ptext (sLit "Occ=") <> ppr occ_info)
-	  , (has_dmd,  ptext (sLit "Dmd=") <> ppr dmd_info)
-	  , (has_lbv , ptext (sLit "Lbv=") <> ppr lbv_info)
-	  ]
+    doc = showAttributes
+          [ (has_prag, ptext (sLit "InlPrag=") <> ppr prag_info)
+          , (has_occ,  ptext (sLit "Occ=") <> ppr occ_info)
+          , (has_dmd,  ptext (sLit "Dmd=") <> ppr dmd_info)
+          , (has_lbv , ptext (sLit "Lbv=") <> ppr lbv_info)
+          ]
 \end{code}
 
 
 -----------------------------------------------------
---	IdDetails and IdInfo
+--      IdDetails and IdInfo
 -----------------------------------------------------
 
 \begin{code}
 ppIdInfo :: Id -> IdInfo -> SDoc
 ppIdInfo id info
-  | opt_SuppressIdInfo	= empty
+  | opt_SuppressIdInfo  = empty
   | otherwise
   = showAttributes
     [ (True, pp_scope <> ppr (idDetails id))
@@ -359,13 +352,13 @@ ppIdInfo id info
     , (has_strictness, ptext (sLit "Str=") <> pprStrictness str_info)
     , (has_unf,        ptext (sLit "Unf=") <> ppr unf_info)
     , (not (null rules), ptext (sLit "RULES:") <+> vcat (map pprRule rules))
-    ]	-- Inline pragma, occ, demand, lbvar info
-	-- printed out with all binders (when debug is on); 
-	-- see PprCore.pprIdBndr
+    ]   -- Inline pragma, occ, demand, lbvar info
+        -- printed out with all binders (when debug is on);
+        -- see PprCore.pprIdBndr
   where
     pp_scope | isGlobalId id   = ptext (sLit "GblId")
-    	     | isExportedId id = ptext (sLit "LclIdX")
-    	     | otherwise       = ptext (sLit "LclId")
+             | isExportedId id = ptext (sLit "LclIdX")
+             | otherwise       = ptext (sLit "LclId")
 
     arity = arityInfo info
     has_arity = arity /= 0
@@ -382,7 +375,7 @@ ppIdInfo id info
     rules = specInfoRules (specInfo info)
 
 showAttributes :: [(Bool,SDoc)] -> SDoc
-showAttributes stuff 
+showAttributes stuff
   | null docs = empty
   | otherwise = brackets (sep (punctuate comma docs))
   where
@@ -390,21 +383,21 @@ showAttributes stuff
 \end{code}
 
 -----------------------------------------------------
---	Unfolding and UnfoldingGuidance
+--      Unfolding and UnfoldingGuidance
 -----------------------------------------------------
 
 \begin{code}
 instance Outputable UnfoldingGuidance where
     ppr UnfNever  = ptext (sLit "NEVER")
     ppr (UnfWhen unsat_ok boring_ok)
-      = ptext (sLit "ALWAYS_IF") <> 
+      = ptext (sLit "ALWAYS_IF") <>
         parens (ptext (sLit "unsat_ok=") <> ppr unsat_ok <> comma <>
                 ptext (sLit "boring_ok=") <> ppr boring_ok)
     ppr (UnfIfGoodArgs { ug_args = cs, ug_size = size, ug_res = discount })
-      = hsep [ ptext (sLit "IF_ARGS"), 
-	       brackets (hsep (map int cs)),
-	       int size,
-	       int discount ]
+      = hsep [ ptext (sLit "IF_ARGS"),
+               brackets (hsep (map int cs)),
+               int size,
+               int discount ]
 
 instance Outputable UnfoldingSource where
   ppr InlineCompulsory  = ptext (sLit "Compulsory")
@@ -413,19 +406,19 @@ instance Outputable UnfoldingSource where
   ppr InlineRhs         = ptext (sLit "<vanilla>")
 
 instance Outputable Unfolding where
-  ppr NoUnfolding             	 = ptext (sLit "No unfolding")
-  ppr (OtherCon cs)           	 = ptext (sLit "OtherCon") <+> ppr cs
-  ppr (DFunUnfolding ar con ops) = ptext (sLit "DFun") <> parens (ptext (sLit "arity=") <> int ar)  
+  ppr NoUnfolding                = ptext (sLit "No unfolding")
+  ppr (OtherCon cs)              = ptext (sLit "OtherCon") <+> ppr cs
+  ppr (DFunUnfolding ar con ops) = ptext (sLit "DFun") <> parens (ptext (sLit "arity=") <> int ar)
                                    <+> ppr con <+> brackets (pprWithCommas ppr ops)
   ppr (CoreUnfolding { uf_src = src
                      , uf_tmpl=rhs, uf_is_top=top, uf_is_value=hnf
                      , uf_is_conlike=conlike, uf_is_work_free=wf
-      		     , uf_expandable=exp, uf_guidance=g, uf_arity=arity}) 
-	= ptext (sLit "Unf") <> braces (pp_info $$ pp_rhs)
+                     , uf_expandable=exp, uf_guidance=g, uf_arity=arity})
+        = ptext (sLit "Unf") <> braces (pp_info $$ pp_rhs)
     where
-      pp_info = fsep $ punctuate comma 
+      pp_info = fsep $ punctuate comma
                 [ ptext (sLit "Src=")        <> ppr src
-                , ptext (sLit "TopLvl=")     <> ppr top 
+                , ptext (sLit "TopLvl=")     <> ppr top
                 , ptext (sLit "Arity=")      <> int arity
                 , ptext (sLit "Value=")      <> ppr hnf
                 , ptext (sLit "ConLike=")    <> ppr conlike
@@ -435,8 +428,8 @@ instance Outputable Unfolding where
       pp_tmpl = ptext (sLit "Tmpl=") <+> ppr rhs
       pp_rhs | isStableSource src = pp_tmpl
              | otherwise          = empty
-            -- Don't print the RHS or we get a quadratic 
-	    -- blowup in the size of the printout!
+            -- Don't print the RHS or we get a quadratic
+            -- blowup in the size of the printout!
 \end{code}
 
 -----------------------------------------------------
@@ -458,7 +451,7 @@ pprRule (Rule { ru_name = name, ru_act = act, ru_fn = fn,
                 ru_bndrs = tpl_vars, ru_args = tpl_args,
                 ru_rhs = rhs })
   = hang (doubleQuotes (ftext name) <+> ppr act)
-       4 (sep [ptext (sLit "forall") <+> 
+       4 (sep [ptext (sLit "forall") <+>
                   sep (map (pprCoreBinder LambdaBind) tpl_vars) <> dot,
                nest 2 (ppr fn <+> sep (map pprArg tpl_args)),
                nest 2 (ptext (sLit "=") <+> pprCoreExpr rhs)