[ci skip] typecheck: detabify/dewhitespace TcInstDecls

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

1 files changed, 54 insertions, 60 deletions

diff --git a/compiler/typecheck/TcInstDcls.lhs b/compiler/typecheck/TcInstDcls.lhs
index f559dda17f..70553ff862 100644
--- a/compiler/typecheck/TcInstDcls.lhs
+++ b/compiler/typecheck/TcInstDcls.lhs
@@ -7,12 +7,6 @@ TcInstDecls: Typechecking instance declarations
 
 \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 TcInstDcls ( tcInstDecls1, tcInstDecls2 ) where
 
@@ -21,7 +15,7 @@ module TcInstDcls ( tcInstDecls1, tcInstDecls2 ) where
 import HsSyn
 import TcBinds
 import TcTyClsDecls
-import TcClassDcl( tcClassDecl2, 
+import TcClassDcl( tcClassDecl2,
                    HsSigFun, lookupHsSig, mkHsSigFun,
                    findMethodBind, instantiateMethod, tcInstanceMethodBody )
 import TcPat      ( addInlinePrags )
@@ -48,7 +42,7 @@ import DataCon
 import Class
 import Var
 import VarEnv
-import VarSet 
+import VarSet
 import CoreUnfold ( mkDFunUnfolding )
 import CoreSyn    ( Expr(Var, Type), CoreExpr, mkTyApps, mkVarApps )
 import PrelNames  ( tYPEABLE_INTERNAL, typeableClassName,
@@ -373,7 +367,7 @@ tcInstDecls1    -- Deal with both source-code and imported instance decls
                                 -- contains all dfuns for this module
            HsValBinds Name)     -- Supporting bindings for derived instances
 
-tcInstDecls1 tycl_decls inst_decls deriv_decls 
+tcInstDecls1 tycl_decls inst_decls deriv_decls
   = checkNoErrs $
     do {    -- Stop if addInstInfos etc discovers any errors
             -- (they recover, so that we get more than one error each
@@ -403,7 +397,7 @@ tcInstDecls1 tycl_decls inst_decls deriv_decls
        ; traceTc "tcDeriving" Outputable.empty
        ; th_stage <- getStage   -- See Note [Deriving inside TH brackets ]
        ; (gbl_env, deriv_inst_info, deriv_binds)
-              <- if isBrackStage th_stage 
+              <- if isBrackStage th_stage
                  then do { gbl_env <- getGblEnv
                          ; return (gbl_env, emptyBag, emptyValBindsOut) }
                  else tcDeriving tycl_decls inst_decls deriv_decls
@@ -447,7 +441,7 @@ tcInstDecls1 tycl_decls inst_decls deriv_decls
 
     typInstCheck ty = is_cls_nm (iSpec ty) `elem` oldTypeableClassNames
     typInstErr i = hang (ptext (sLit $ "Typeable instances can only be "
-                            ++ "derived in Safe Haskell.") $+$ 
+                            ++ "derived in Safe Haskell.") $+$
                          ptext (sLit "Replace the following instance:"))
                      2 (pprInstanceHdr (iSpec i))
 
@@ -455,7 +449,7 @@ tcInstDecls1 tycl_decls inst_decls deriv_decls
                         [Overlappable, Overlapping, Overlaps]
     genInstCheck ty = is_cls_nm (iSpec ty) `elem` genericClassNames
     genInstErr i = hang (ptext (sLit $ "Generic instances can only be "
-                            ++ "derived in Safe Haskell.") $+$ 
+                            ++ "derived in Safe Haskell.") $+$
                          ptext (sLit "Replace the following instance:"))
                      2 (pprInstanceHdr (iSpec i))
 
@@ -471,15 +465,15 @@ addFamInsts :: [FamInst] -> TcM a -> TcM a
 -- Extend (a) the family instance envt
 --        (b) the type envt with stuff from data type decls
 addFamInsts fam_insts thing_inside
-  = tcExtendLocalFamInstEnv fam_insts $ 
-    tcExtendGlobalEnv things  $ 
+  = tcExtendLocalFamInstEnv fam_insts $
+    tcExtendGlobalEnv things  $
     do { traceTc "addFamInsts" (pprFamInsts fam_insts)
        ; tcg_env <- tcAddImplicits things
        ; setGblEnv tcg_env thing_inside }
   where
     axioms = map (toBranchedAxiom . famInstAxiom) fam_insts
     tycons = famInstsRepTyCons fam_insts
-    things = map ATyCon tycons ++ map ACoAxiom axioms 
+    things = map ATyCon tycons ++ map ACoAxiom axioms
 \end{code}
 
 Note [Deriving inside TH brackets]
@@ -490,12 +484,12 @@ Given a declaration bracket
 there is really no point in generating the derived code for deriving(
 Show) and then type-checking it. This will happen at the call site
 anyway, and the type check should never fail!  Moreover (Trac #6005)
-the scoping of the generated code inside the bracket does not seem to 
-work out.  
+the scoping of the generated code inside the bracket does not seem to
+work out.
 
 The easy solution is simply not to generate the derived instances at
 all.  (A less brutal solution would be to generate them with no
-bindings.)  This will become moot when we shift to the new TH plan, so 
+bindings.)  This will become moot when we shift to the new TH plan, so
 the brutal solution will do.
 
 
@@ -533,7 +527,7 @@ tcClsInstDecl (L loc (ClsInstDecl { cid_poly_ty = poly_ty, cid_binds = binds
         ; let mini_env   = mkVarEnv (classTyVars clas `zip` inst_tys)
               mini_subst = mkTvSubst (mkInScopeSet (mkVarSet tyvars)) mini_env
               mb_info    = Just (clas, mini_env)
-                           
+
         -- Next, process any associated types.
         ; traceTc "tcLocalInstDecl" (ppr poly_ty)
         ; tyfam_insts0 <- tcExtendTyVarEnv tyvars $
@@ -544,11 +538,11 @@ tcClsInstDecl (L loc (ClsInstDecl { cid_poly_ty = poly_ty, cid_binds = binds
         -- Check for missing associated types and build them
         -- from their defaults (if available)
         ; let defined_ats = mkNameSet (map (tyFamInstDeclName . unLoc) ats)
-                            `unionNameSets` 
+                            `unionNameSets`
                             mkNameSet (map (unLoc . dfid_tycon . unLoc) adts)
-        ; tyfam_insts1 <- mapM (tcATDefault mini_subst defined_ats) 
+        ; tyfam_insts1 <- mapM (tcATDefault mini_subst defined_ats)
                                (classATItems clas)
-        
+
         -- Finally, construct the Core representation of the instance.
         -- (This no longer includes the associated types.)
         ; dfun_name <- newDFunName clas inst_tys (getLoc poly_ty)
@@ -558,9 +552,9 @@ tcClsInstDecl (L loc (ClsInstDecl { cid_poly_ty = poly_ty, cid_binds = binds
             do defaultOverlapFlag <- getOverlapFlag
                return $ setOverlapModeMaybe defaultOverlapFlag overlap_mode
         ; (subst, tyvars') <- tcInstSkolTyVars tyvars
-        ; let dfun  	= mkDictFunId dfun_name tyvars theta clas inst_tys
-              ispec 	= mkLocalInstance dfun overlap_flag tyvars' clas (substTys subst inst_tys)
-                            -- Be sure to freshen those type variables, 
+        ; let dfun      = mkDictFunId dfun_name tyvars theta clas inst_tys
+              ispec     = mkLocalInstance dfun overlap_flag tyvars' clas (substTys subst inst_tys)
+                            -- Be sure to freshen those type variables,
                             -- so they are sure not to appear in any lookup
               inst_info = InstInfo { iSpec  = ispec
                                    , iBinds = InstBindings
@@ -595,7 +589,7 @@ tcATDefault inst_subst defined_ats (ATI fam_tc defs)
        ; let axiom = mkSingleCoAxiom rep_tc_name tvs' fam_tc pat_tys' rhs'
        ; traceTc "mk_deflt_at_instance" (vcat [ ppr fam_tc, ppr rhs_ty
                                               , pprCoAxiom axiom ])
-       ; fam_inst <- ASSERT( tyVarsOfType rhs' `subVarSet` tv_set' ) 
+       ; fam_inst <- ASSERT( tyVarsOfType rhs' `subVarSet` tv_set' )
                      newFamInst SynFamilyInst axiom
        ; return [fam_inst] }
 
@@ -604,19 +598,19 @@ tcATDefault inst_subst defined_ats (ATI fam_tc defs)
   = do { warnMissingMethodOrAT "associated type" (tyConName fam_tc)
        ; return [] }
   where
-    subst_tv subst tc_tv 
+    subst_tv subst tc_tv
       | Just ty <- lookupVarEnv (getTvSubstEnv subst) tc_tv
       = (subst, ty)
       | otherwise
       = (extendTvSubst subst tc_tv ty', ty')
       where
         ty' = mkTyVarTy (updateTyVarKind (substTy subst) tc_tv)
-                           
+
 
 --------------
 tcAssocTyDecl :: Class                   -- Class of associated type
               -> VarEnv Type             -- Instantiation of class TyVars
-              -> LTyFamInstDecl Name     
+              -> LTyFamInstDecl Name
               -> TcM (FamInst)
 tcAssocTyDecl clas mini_env ldecl
   = do { fam_inst <- tcTyFamInstDecl (Just (clas, mini_env)) ldecl
@@ -684,7 +678,7 @@ tcTyFamInstDecl mb_clsinfo (L loc decl@(TyFamInstDecl { tfid_eqn = eqn }))
 tcDataFamInstDecl :: Maybe (Class, VarEnv Type)
                   -> LDataFamInstDecl Name -> TcM FamInst
   -- "newtype instance" and "data instance"
-tcDataFamInstDecl mb_clsinfo 
+tcDataFamInstDecl mb_clsinfo
     (L loc decl@(DataFamInstDecl
        { dfid_pats = pats
        , dfid_tycon = fam_tc_name
@@ -700,7 +694,7 @@ tcDataFamInstDecl mb_clsinfo
 
          -- Kind check type patterns
        ; tcFamTyPats (famTyConShape fam_tc) pats
-                     (kcDataDefn defn) $ 
+                     (kcDataDefn defn) $
            \tvs' pats' res_kind -> do
 
        { -- Check that left-hand side contains no type family applications
@@ -709,7 +703,7 @@ tcDataFamInstDecl mb_clsinfo
          checkValidFamPats fam_tc tvs' pats'
          -- Check that type patterns match class instance head, if any
        ; checkConsistentFamInst mb_clsinfo fam_tc tvs' pats'
-         
+
          -- Result kind must be '*' (otherwise, we have too few patterns)
        ; checkTc (isLiftedTypeKind res_kind) $ tooFewParmsErr (tyConArity fam_tc)
 
@@ -730,12 +724,12 @@ tcDataFamInstDecl mb_clsinfo
                                  mkNewTyConRhs rep_tc_name rec_rep_tc (head data_cons)
               -- freshen tyvars
               ; let (eta_tvs, eta_pats) = eta_reduce tvs' pats'
-                    axiom    = mkSingleCoAxiom axiom_name eta_tvs fam_tc eta_pats 
+                    axiom    = mkSingleCoAxiom axiom_name eta_tvs fam_tc eta_pats
                                                (mkTyConApp rep_tc (mkTyVarTys eta_tvs))
                     parent   = FamInstTyCon axiom fam_tc pats'
                     roles    = map (const Nominal) tvs'
-                    rep_tc   = buildAlgTyCon rep_tc_name tvs' roles cType stupid_theta tc_rhs 
-                                             Recursive 
+                    rep_tc   = buildAlgTyCon rep_tc_name tvs' roles cType stupid_theta tc_rhs
+                                             Recursive
                                              False      -- No promotable to the kind level
                                              gadt_syntax parent
                  -- We always assume that indexed types are recursive.  Why?
@@ -911,9 +905,9 @@ tcInstDecl2 (InstInfo { iSpec = ispec, iBinds = ibinds })
 
              dfun_args :: [CoreExpr]
              dfun_args = map Type inst_tys        ++
-                         map Var  sc_ev_vars      ++ 
+                         map Var  sc_ev_vars      ++
                          map mk_meth_app meth_ids
-             mk_meth_app meth_id = Var meth_id `mkTyApps` inst_tv_tys `mkVarApps` dfun_ev_vars 
+             mk_meth_app meth_id = Var meth_id `mkTyApps` inst_tv_tys `mkVarApps` dfun_ev_vars
 
              export = ABE { abe_wrap = idHsWrapper, abe_poly = dfun_id_w_fun
                           , abe_mono = self_dict, abe_prags = dfun_spec_prags }
@@ -941,7 +935,7 @@ tcSuperClasses dfun_id inst_tyvars dfun_ev_vars sc_theta
        ; (sc_binds, sc_evs) <- checkConstraints InstSkol inst_tyvars orig_ev_vars $
                                emitWanteds ScOrigin sc_theta
 
-       ; if null inst_tyvars && null dfun_ev_vars 
+       ; if null inst_tyvars && null dfun_ev_vars
          then return (sc_binds,       sc_evs)
          else return (emptyTcEvBinds, sc_lam_args) }
   where
@@ -949,14 +943,14 @@ tcSuperClasses dfun_id inst_tyvars dfun_ev_vars sc_theta
     orig_ev_vars = drop n_silent dfun_ev_vars
 
     sc_lam_args = map (find dfun_ev_vars) sc_theta
-    find [] pred 
+    find [] pred
       = pprPanic "tcInstDecl2" (ppr dfun_id $$ ppr (idType dfun_id) $$ ppr pred)
-    find (ev:evs) pred 
+    find (ev:evs) pred
       | pred `eqPred` evVarPred ev = ev
       | otherwise                  = find evs pred
 
 ----------------------
-mkMethIds :: HsSigFun -> Class -> [TcTyVar] -> [EvVar] 
+mkMethIds :: HsSigFun -> Class -> [TcTyVar] -> [EvVar]
           -> [TcType] -> Id -> TcM (TcId, TcSigInfo)
 mkMethIds sig_fn clas tyvars dfun_ev_vars inst_tys sel_id
   = do  { let sel_occ = nameOccName sel_name
@@ -988,11 +982,11 @@ mkMethIds sig_fn clas tyvars dfun_ev_vars inst_tys sel_id
     meth_ty       = mkForAllTys tyvars $ mkPiTypes dfun_ev_vars local_meth_ty
 
     -- Check that any type signatures have exactly the right type
-    check_inst_sig hs_ty@(L loc _) 
-       = setSrcSpan loc $ 
+    check_inst_sig hs_ty@(L loc _)
+       = setSrcSpan loc $
          do { sig_ty <- tcHsSigType (FunSigCtxt sel_name) hs_ty
             ; inst_sigs <- xoptM Opt_InstanceSigs
-            ; if inst_sigs then 
+            ; if inst_sigs then
                 unless (sig_ty `eqType` local_meth_ty)
                        (badInstSigErr sel_name local_meth_ty)
               else
@@ -1003,7 +997,7 @@ badInstSigErr :: Name -> Type -> TcM ()
 badInstSigErr meth ty
   = do { env0 <- tcInitTidyEnv
        ; let tidy_ty = tidyType env0 ty
-                 -- Tidy the type using the ambient TidyEnv, 
+                 -- Tidy the type using the ambient TidyEnv,
                  -- to avoid apparent name capture (Trac #7475)
                  --    class C a where { op :: a -> b }
                  --    instance C (a->b) where
@@ -1033,7 +1027,7 @@ Note [Silent superclass arguments]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 See Trac #3731, #4809, #5751, #5913, #6117, which all
 describe somewhat more complicated situations, but ones
-encountered in practice.  
+encountered in practice.
 
       THE PROBLEM
 
@@ -1100,7 +1094,7 @@ In our example, if we had  [Wanted] dw :: D [a] we would get via the instance:
     [Wanted] (d1 :: C [a])
     [Wanted] (d2 :: D [a])
 
-And now, though we *can* solve: 
+And now, though we *can* solve:
      d2 := dw
 That's fine; and we solve d1:C[a] separately.
 
@@ -1142,11 +1136,11 @@ The SPECIALISE pragmas are acted upon by the desugarer, which generate
   $c$crangePair = ...specialised RHS of $crangePair...
 
   {-# RULE forall (d1,d2:Ix Int). $crangePair Int Int d1 d2 = $s$crangePair #-}
- 
+
 Note that
 
   * The specialised dictionary $s$dfIxPair is very much needed, in case we
-    call a function that takes a dictionary, but in a context where the 
+    call a function that takes a dictionary, but in a context where the
     specialised dictionary can be used.  See Trac #7797.
 
   * The ClassOp rule for 'range' works equally well on $s$dfIxPair, because
@@ -1220,12 +1214,12 @@ tcInstanceMethods dfun_id clas tyvars dfun_ev_vars inst_tys
   where
     set_exts :: [ExtensionFlag] -> TcM a -> TcM a
     set_exts es thing = foldr setXOptM thing es
-    
+
     ----------------------
     tc_item :: HsSigFun -> (Id, DefMeth) -> TcM (Id, LHsBind Id)
     tc_item sig_fn (sel_id, dm_info)
       = case findMethodBind (idName sel_id) binds of
-            Just (user_bind, bndr_loc) 
+            Just (user_bind, bndr_loc)
                      -> tc_body sig_fn sel_id standalone_deriv user_bind bndr_loc
             Nothing  -> do { traceTc "tc_def" (ppr sel_id)
                            ; tc_default sig_fn sel_id dm_info }
@@ -1254,7 +1248,7 @@ tcInstanceMethods dfun_id clas tyvars dfun_ev_vars inst_tys
 
     tc_default sig_fn sel_id (GenDefMeth dm_name)
       = do { meth_bind <- mkGenericDefMethBind clas inst_tys sel_id dm_name
-           ; tc_body sig_fn sel_id False {- Not generated code? -} 
+           ; tc_body sig_fn sel_id False {- Not generated code? -}
                      meth_bind inst_loc }
 
     tc_default sig_fn sel_id NoDefMeth     -- No default method at all
@@ -1299,7 +1293,7 @@ tcInstanceMethods dfun_id clas tyvars dfun_ev_vars inst_tys
                         -- Copy the inline pragma (if any) from the default
                         -- method to this version. Note [INLINE and default methods]
 
-                  
+
                  export = ABE { abe_wrap = idHsWrapper, abe_poly = meth_id1
                               , abe_mono = local_meth_id
                               , abe_prags = mk_meth_spec_prags meth_id1 [] }
@@ -1331,7 +1325,7 @@ tcInstanceMethods dfun_id clas tyvars dfun_ev_vars inst_tys
                  -- method is marked INLINE, because then it'll be inlined
                  -- and the specialisation would do nothing. (Indeed it'll provoke
                  -- a warning from the desugarer
-           | otherwise 
+           | otherwise
            = [ L inst_loc (SpecPrag meth_id wrap inl)
              | L inst_loc (SpecPrag _ wrap inl) <- spec_inst_prags]
 
@@ -1355,13 +1349,13 @@ tcInstanceMethods dfun_id clas tyvars dfun_ev_vars inst_tys
 
 mkGenericDefMethBind :: Class -> [Type] -> Id -> Name -> TcM (LHsBind Name)
 mkGenericDefMethBind clas inst_tys sel_id dm_name
-  = 	-- A generic default method
-    	-- If the method is defined generically, we only have to call the
+  =     -- A generic default method
+        -- If the method is defined generically, we only have to call the
         -- dm_name.
-    do	{ dflags <- getDynFlags
-	; liftIO (dumpIfSet_dyn dflags Opt_D_dump_deriv "Filling in method body"
-		   (vcat [ppr clas <+> ppr inst_tys,
-			  nest 2 (ppr sel_id <+> equals <+> ppr rhs)]))
+    do  { dflags <- getDynFlags
+        ; liftIO (dumpIfSet_dyn dflags Opt_D_dump_deriv "Filling in method body"
+                   (vcat [ppr clas <+> ppr inst_tys,
+                          nest 2 (ppr sel_id <+> equals <+> ppr rhs)]))
 
         ; return (noLoc $ mkTopFunBind Generated (noLoc (idName sel_id))
                                        [mkSimpleMatch [] rhs]) }