Untabify and M-x whitespace cleanup
authorGabor Greif <ggreif@gmail.com>
Wed, 25 Jun 2014 09:52:11 +0000 (11:52 +0200)
committerGabor Greif <ggreif@gmail.com>
Sat, 28 Jun 2014 11:09:31 +0000 (13:09 +0200)
compiler/typecheck/TcGenGenerics.lhs

index 648979b..ea87520 100644 (file)
@@ -7,12 +7,6 @@ The deriving code for the Generic class
 
 \begin{code}
 {-# LANGUAGE CPP, ScopedTypeVariables #-}
-{-# 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 TcGenGenerics (canDoGenerics, canDoGenerics1,
@@ -46,7 +40,7 @@ import BuildTyCl
 import SrcLoc
 import Bag
 import VarSet (elemVarSet)
-import Outputable 
+import Outputable
 import FastString
 import Util
 
@@ -64,7 +58,7 @@ import Control.Monad (mplus,forM)
 For the generic representation we need to generate:
 \begin{itemize}
 \item A Generic instance
-\item A Rep type instance 
+\item A Rep type instance
 \item Many auxiliary datatypes and instances for them (for the meta-information)
 \end{itemize}
 
@@ -90,7 +84,7 @@ genGenericMetaTyCons tc mod =
 
         mkTyCon name = ASSERT( isExternalName name )
                        buildAlgTyCon name [] [] Nothing [] distinctAbstractTyConRhs
-                                          NonRecursive 
+                                          NonRecursive
                                           False          -- Not promotable
                                           False          -- Not GADT syntax
                                           NoParentTyCon
@@ -121,21 +115,21 @@ metaTyConsToDerivStuff tc metaDts =
       cClas <- tcLookupClass constructorClassName
       c_dfun_names <- sequence [ new_dfun_name cClas tc | _ <- metaC metaDts ]
       sClas <- tcLookupClass selectorClassName
-      s_dfun_names <- sequence (map sequence [ [ new_dfun_name sClas tc 
-                                               | _ <- x ] 
+      s_dfun_names <- sequence (map sequence [ [ new_dfun_name sClas tc
+                                               | _ <- x ]
                                              | x <- metaS metaDts ])
       fix_env <- getFixityEnv
 
       let
         safeOverlap = safeLanguageOn dflags
         (dBinds,cBinds,sBinds) = mkBindsMetaD fix_env tc
-        mk_inst clas tc dfun_name 
+        mk_inst clas tc dfun_name
           = mkLocalInstance (mkDictFunId dfun_name [] [] clas tys)
                             (NoOverlap safeOverlap)
                             [] clas tys
           where
             tys = [mkTyConTy tc]
-        
+
         -- Datatype
         d_metaTycon = metaD metaDts
         d_inst   = mk_inst dClas d_metaTycon d_dfun_name
@@ -144,7 +138,7 @@ metaTyConsToDerivStuff tc metaDts =
                                 , ib_extensions = []
                                 , ib_standalone_deriving = False }
         d_mkInst = DerivInst (InstInfo { iSpec = d_inst, iBinds = d_binds })
-        
+
         -- Constructor
         c_metaTycons = metaC metaDts
         c_insts = [ mk_inst cClas c ds
@@ -156,7 +150,7 @@ metaTyConsToDerivStuff tc metaDts =
                   | c <- cBinds ]
         c_mkInst = [ DerivInst (InstInfo { iSpec = is, iBinds = bs })
                    | (is,bs) <- myZip1 c_insts c_binds ]
-        
+
         -- Selector
         s_metaTycons = metaS metaDts
         s_insts = map (map (\(s,ds) -> mk_inst sClas s ds))
@@ -169,15 +163,15 @@ metaTyConsToDerivStuff tc metaDts =
         s_mkInst = map (map (\(is,bs) -> DerivInst (InstInfo { iSpec  = is
                                                              , iBinds = bs})))
                        (myZip2 s_insts s_binds)
-       
+
         myZip1 :: [a] -> [b] -> [(a,b)]
         myZip1 l1 l2 = ASSERT(length l1 == length l2) zip l1 l2
-        
+
         myZip2 :: [[a]] -> [[b]] -> [[(a,b)]]
         myZip2 l1 l2 =
           ASSERT(and (zipWith (>=) (map length l1) (map length l2)))
             [ zip x1 x2 | (x1,x2) <- zip l1 l2 ]
-        
+
       return $ mapBag DerivTyCon (metaTyCons2TyCons metaDts)
                `unionBags` listToBag (d_mkInst : c_mkInst ++ concat s_mkInst)
 \end{code}
@@ -286,8 +280,8 @@ canDoGenerics tc tc_args
                           then (Just (ppr dc <+> text "must be a vanilla data constructor"))
                           else Nothing)
 
-       -- Nor can we do the job if it's an existential data constructor,
-       -- Nor if the args are polymorphic types (I don't think)
+        -- Nor can we do the job if it's an existential data constructor,
+        -- Nor if the args are polymorphic types (I don't think)
     bad_arg_type ty = isUnLiftedType ty || not (isTauTy ty)
 
 mergeErrors :: [Maybe SDoc] -> Maybe SDoc
@@ -401,13 +395,13 @@ canDoGenerics1 rep_tc tc_args =
 \end{code}
 
 %************************************************************************
-%*                                                                     *
+%*                                                                      *
 \subsection{Generating the RHS of a generic default method}
-%*                                                                     *
+%*                                                                      *
 %************************************************************************
 
 \begin{code}
-type US = Int  -- Local unique supply, just a plain Int
+type US = Int   -- Local unique supply, just a plain Int
 type Alt = (LPat RdrName, LHsExpr RdrName)
 
 -- GenericKind serves to mark if a datatype derives Generic (Gen0) or
@@ -434,7 +428,7 @@ gk2gkDC Gen1_{} d = Gen1_DC $ last $ dataConUnivTyVars d
 
 -- Bindings for the Generic instance
 mkBindsRep :: GenericKind -> TyCon -> LHsBinds RdrName
-mkBindsRep gk tycon = 
+mkBindsRep gk tycon =
     unitBag (mkRdrFunBind (L loc from01_RDR) from_matches)
   `unionBags`
     unitBag (mkRdrFunBind (L loc to01_RDR) to_matches)
@@ -456,7 +450,7 @@ mkBindsRep gk tycon =
                   Gen1 -> ASSERT(length tyvars >= 1)
                           Gen1_ (last tyvars)
                     where tyvars = tyConTyVars tycon
-        
+
 --------------------------------------------------------------------------------
 -- The type synonym instance and synonym
 --       type instance Rep (D a b) = Rep_D a b
@@ -468,7 +462,7 @@ tc_mkRepFamInsts :: GenericKind     -- Gen0 or Gen1
                -> MetaTyCons      -- Metadata datatypes to refer to
                -> Module          -- Used as the location of the new RepTy
                -> TcM (FamInst)   -- Generated representation0 coercion
-tc_mkRepFamInsts gk tycon metaDts mod = 
+tc_mkRepFamInsts gk tycon metaDts mod =
        -- Consider the example input tycon `D`, where data D a b = D_ a
        -- Also consider `R:DInt`, where { data family D x y :: * -> *
        --                               ; data instance D Int a b = D_ a }
@@ -501,7 +495,7 @@ tc_mkRepFamInsts gk tycon metaDts mod =
 
        -- `repTy` = D1 ... (C1 ... (S1 ... (Rec0 a))) :: * -> *
      ; repTy <- tc_mkRepTy gk_ tycon metaDts
-    
+
        -- `rep_name` is a name we generate for the synonym
      ; rep_name <- let mkGen = case gk of Gen0 -> mkGenR; Gen1 -> mkGen1R
                    in newGlobalBinder mod (mkGen (nameOccName (tyConName tycon)))
@@ -584,10 +578,10 @@ tc_mkRepTy ::  -- Gen0_ or Gen1_, for Rep or Rep1
               -- The type to generate representation for
             -> TyCon
                -- Metadata datatypes to refer to
-            -> MetaTyCons 
+            -> MetaTyCons
                -- Generated representation0 type
             -> TcM Type
-tc_mkRepTy gk_ tycon metaDts = 
+tc_mkRepTy gk_ tycon metaDts =
   do
     d1    <- tcLookupTyCon d1TyConName
     c1    <- tcLookupTyCon c1TyConName
@@ -601,7 +595,7 @@ tc_mkRepTy gk_ tycon metaDts =
     plus  <- tcLookupTyCon sumTyConName
     times <- tcLookupTyCon prodTyConName
     comp  <- tcLookupTyCon compTyConName
-    
+
     let mkSum' a b = mkTyConApp plus  [a,b]
         mkProd a b = mkTyConApp times [a,b]
         mkComp a b = mkTyConApp comp  [a,b]
@@ -615,7 +609,7 @@ tc_mkRepTy gk_ tycon metaDts =
         mkS True  _ a = mkTyConApp s1 [mkTyConTy nS1, a]
         -- This field has a  label
         mkS False d a = mkTyConApp s1 [d, a]
-        
+
         -- Sums and products are done in the same way for both Rep and Rep1
         sumP [] = mkTyConTy v1
         sumP l  = ASSERT(length metaCTyCons == length l)
@@ -630,9 +624,9 @@ tc_mkRepTy gk_ tycon metaDts =
                         ASSERT(length l == length (metaSTyCons !! i))
                           foldBal mkProd [ arg d t b
                                          | (d,t) <- zip (metaSTyCons !! i) l ]
-        
+
         arg :: Type -> Type -> Bool -> Type
-        arg d t b = mkS b d $ case gk_ of 
+        arg d t b = mkS b d $ case gk_ of
             -- Here we previously used Par0 if t was a type variable, but we
             -- realized that we can't always guarantee that we are wrapping-up
             -- all type variables in Par0. So we decided to stop using Par0
@@ -645,12 +639,12 @@ tc_mkRepTy gk_ tycon metaDts =
             argPar argVar = argTyFold argVar $ ArgTyAlg
               {ata_rec0 = mkRec0, ata_par1 = mkPar1,
                ata_rec1 = mkRec1, ata_comp = mkComp}
-        
-       
+
+
         metaDTyCon  = mkTyConTy (metaD metaDts)
         metaCTyCons = map mkTyConTy (metaC metaDts)
         metaSTyCons = map (map mkTyConTy) (metaS metaDts)
-        
+
     return (mkD tycon)
 
 --------------------------------------------------------------------------------
@@ -663,22 +657,22 @@ data MetaTyCons = MetaTyCons { -- One meta datatype per dataype
                              , metaC :: [TyCon]
                                -- One meta datatype per selector per constructor
                              , metaS :: [[TyCon]] }
-                             
+
 instance Outputable MetaTyCons where
   ppr (MetaTyCons d c s) = ppr d $$ vcat (map ppr c) $$ vcat (map ppr (concat s))
-                                   
+
 metaTyCons2TyCons :: MetaTyCons -> Bag TyCon
 metaTyCons2TyCons (MetaTyCons d c s) = listToBag (d : c ++ concat s)
 
 
 -- Bindings for Datatype, Constructor, and Selector instances
-mkBindsMetaD :: FixityEnv -> TyCon 
+mkBindsMetaD :: FixityEnv -> TyCon
              -> ( LHsBinds RdrName      -- Datatype instance
                 , [LHsBinds RdrName]    -- Constructor instances
                 , [[LHsBinds RdrName]]) -- Selector instances
 mkBindsMetaD fix_env tycon = (dtBinds, allConBinds, allSelBinds)
       where
-        mkBag l = foldr1 unionBags 
+        mkBag l = foldr1 unionBags
                     [ unitBag (mkRdrFunBind (L loc name) matches)
                         | (name, matches) <- l ]
         dtBinds       = mkBag ( [ (datatypeName_RDR, dtName_matches)
@@ -716,7 +710,7 @@ mkBindsMetaD fix_env tycon = (dtBinds, allConBinds, allSelBinds)
 
         dtName_matches     = mkStringLHS . occNameString . nameOccName
                            $ tyConName_user
-        moduleName_matches = mkStringLHS . moduleNameString . moduleName 
+        moduleName_matches = mkStringLHS . moduleNameString . moduleName
                            . nameModule . tyConName $ tycon
         isNewtype_matches  = [mkSimpleHsAlt nlWildPat (nlHsVar true_RDR)]
 
@@ -777,10 +771,10 @@ mk1Sum gk_ us i n datacon = (from_alt, to_alt)
     us'          = us + n_args
 
     datacon_rdr  = getRdrName datacon
-    
+
     from_alt     = (nlConVarPat datacon_rdr datacon_vars, from_alt_rhs)
     from_alt_rhs = mkM1_E (genLR_E i n (mkProd_E gk_ us' datacon_varTys))
-    
+
     to_alt     = (mkM1_P (genLR_P i n (mkProd_P gk us' datacon_vars)), to_alt_rhs)
                  -- These M1s are meta-information for the datatype
     to_alt_rhs = case gk_ of
@@ -821,9 +815,9 @@ genLR_E i n e
 
 -- Build a product expression
 mkProd_E :: GenericKind_DC      -- Generic or Generic1?
-         -> US             -- Base for unique names
+         -> US              -- Base for unique names
          -> [(RdrName, Type)] -- List of variables matched on the lhs and their types
-        -> LHsExpr RdrName -- Resulting product expression
+         -> LHsExpr RdrName -- Resulting product expression
 mkProd_E _   _ []     = mkM1_E (nlHsVar u1DataCon_RDR)
 mkProd_E gk_ _ varTys = mkM1_E (foldBal prod appVars)
                      -- These M1s are meta-information for the constructor
@@ -847,9 +841,9 @@ wrapArg_E (Gen1_DC argVar) (var, ty) = mkM1_E $ converter ty `nlHsApp` nlHsVar v
 
 -- Build a product pattern
 mkProd_P :: GenericKind   -- Gen0 or Gen1
-         -> US                 -- Base for unique names
-              -> [RdrName]     -- List of variables to match
-              -> LPat RdrName  -- Resulting product pattern
+         -> US                  -- Base for unique names
+               -> [RdrName]     -- List of variables to match
+               -> LPat RdrName  -- Resulting product pattern
 mkProd_P _  _ []   = mkM1_P (nlNullaryConPat u1DataCon_RDR)
 mkProd_P gk _ vars = mkM1_P (foldBal prod appVars)
                      -- These M1s are meta-information for the constructor