Ticket #5589: 0002-Fix-warnings-and-whitespace-in-HsBinds.patch

File 0002-Fix-warnings-and-whitespace-in-HsBinds.patch, 31.6 KB (added by michalt, 2 years ago)

Additional cleanup in HsBinds?.

  • compiler/hsSyn/HsBinds.lhs

    From 67da94b7d5b3e736010bb4de46b7d4064045ff7d Mon Sep 17 00:00:00 2001
    From: Michal Terepeta <michal.terepeta@gmail.com>
    Date: Sun, 30 Oct 2011 12:28:59 +0100
    Subject: [PATCH 2/2] Fix warnings and whitespace in HsBinds.
    
    ---
     compiler/hsSyn/HsBinds.lhs |  401 ++++++++++++++++++++++----------------------
     1 files changed, 198 insertions(+), 203 deletions(-)
    
    diff --git a/compiler/hsSyn/HsBinds.lhs b/compiler/hsSyn/HsBinds.lhs
    index 410f1d4..e42706a 100644
    a b  
    77Datatype for: @BindGroup@, @Bind@, @Sig@, @Bind@. 
    88 
    99\begin{code} 
    10 {-# OPTIONS -fno-warn-incomplete-patterns #-} 
    11 -- The above warning supression flag is a temporary kludge. 
    12 -- While working on this module you are encouraged to remove it and fix 
    13 -- any warnings in the module. See 
    14 --     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings 
    15 -- for details 
    1610{-# LANGUAGE DeriveDataTypeable #-} 
    1711 
    1812module HsBinds where 
    1913 
    2014import {-# SOURCE #-} HsExpr ( pprExpr, LHsExpr, 
    21                                MatchGroup, pprFunBind, 
    22                                GRHSs, pprPatBind ) 
     15                               MatchGroup, pprFunBind, 
     16                               GRHSs, pprPatBind ) 
    2317import {-# SOURCE #-} HsPat  ( LPat ) 
    2418 
    2519import HsTypes 
    import Data.List ( intersect ) 
    4539\end{code} 
    4640 
    4741%************************************************************************ 
    48 %*                                                                      * 
     42%*                                                                      * 
    4943\subsection{Bindings: @BindGroup@} 
    50 %*                                                                      * 
     44%*                                                                      * 
    5145%************************************************************************ 
    5246 
    5347Global bindings (where clauses) 
    Global bindings (where clauses) 
    6155 
    6256type HsLocalBinds id = HsLocalBindsLR id id 
    6357 
    64 data HsLocalBindsLR idL idR     -- Bindings in a 'let' expression 
    65                                -- or a 'where' clause 
     58data HsLocalBindsLR idL idR    -- Bindings in a 'let' expression 
     59                               -- or a 'where' clause 
    6660  = HsValBinds (HsValBindsLR idL idR) 
    6761  | HsIPBinds  (HsIPBinds idR) 
    6862  | EmptyLocalBinds 
    type HsValBinds id = HsValBindsLR id id 
    7266 
    7367data HsValBindsLR idL idR  -- Value bindings (not implicit parameters) 
    7468  = ValBindsIn             -- Before renaming RHS; idR is always RdrName 
    75         (LHsBindsLR idL idR) [LSig idR] -- Not dependency analysed 
    76                                         -- Recursive by default 
     69        (LHsBindsLR idL idR) [LSig idR] -- Not dependency analysed 
     70                                        -- Recursive by default 
    7771 
    78   | ValBindsOut            -- After renaming RHS; idR can be Name or Id 
    79         [(RecFlag, LHsBinds idL)]       -- Dependency analysed, later bindings  
     72  | ValBindsOut            -- After renaming RHS; idR can be Name or Id 
     73        [(RecFlag, LHsBinds idL)]       -- Dependency analysed, later bindings 
    8074                                        -- in the list may depend on earlier 
    8175                                        -- ones. 
    82         [LSig Name] 
     76        [LSig Name] 
    8377  deriving (Data, Typeable) 
    8478 
    8579type LHsBind  id = LHsBindLR  id id 
    data HsBindLR idL idR 
    10397    --                                        @(f :: a -> a) = ... @ 
    10498    FunBind { 
    10599 
    106         fun_id :: Located idL, 
     100        fun_id :: Located idL, 
    107101 
    108         fun_infix :: Bool,      -- ^ True => infix declaration 
     102        fun_infix :: Bool,      -- ^ True => infix declaration 
    109103 
    110         fun_matches :: MatchGroup idR,  -- ^ The payload 
     104        fun_matches :: MatchGroup idR,  -- ^ The payload 
    111105 
    112         fun_co_fn :: HsWrapper, -- ^ Coercion from the type of the MatchGroup to the type of 
    113                                 -- the Id.  Example: 
     106        fun_co_fn :: HsWrapper, -- ^ Coercion from the type of the MatchGroup to the type of 
     107                                -- the Id.  Example: 
    114108                                -- @ 
    115                                 --      f :: Int -> forall a. a -> a 
    116                                 --      f x y = y 
     109                                --      f :: Int -> forall a. a -> a 
     110                                --      f x y = y 
    117111                                -- @ 
    118                                 -- Then the MatchGroup will have type (Int -> a' -> a') 
    119                                 -- (with a free type variable a').  The coercion will take 
    120                                 -- a CoreExpr of this type and convert it to a CoreExpr of 
    121                                 -- type         Int -> forall a'. a' -> a' 
    122                                 -- Notice that the coercion captures the free a'. 
     112                                -- Then the MatchGroup will have type (Int -> a' -> a') 
     113                                -- (with a free type variable a').  The coercion will take 
     114                                -- a CoreExpr of this type and convert it to a CoreExpr of 
     115                                -- type         Int -> forall a'. a' -> a' 
     116                                -- Notice that the coercion captures the free a'. 
    123117 
    124         bind_fvs :: NameSet,    -- ^ After the renamer, this contains the locally-bound 
    125                                 -- free variables of this defn. 
    126                                 -- See Note [Bind free vars] 
     118        bind_fvs :: NameSet,    -- ^ After the renamer, this contains the locally-bound 
     119                                -- free variables of this defn. 
     120                                -- See Note [Bind free vars] 
    127121 
    128122 
    129123        fun_tick :: Maybe (Int,[Id])   -- ^ This is the (optional) module-local tick number. 
    130124    } 
    131125 
    132   | PatBind {   -- The pattern is never a simple variable; 
    133                 -- That case is done by FunBind 
    134         pat_lhs    :: LPat idL, 
    135         pat_rhs    :: GRHSs idR, 
    136         pat_rhs_ty :: PostTcType,       -- Type of the GRHSs 
    137         bind_fvs   :: NameSet           -- See Note [Bind free vars] 
     126  | PatBind {   -- The pattern is never a simple variable; 
     127                -- That case is done by FunBind 
     128        pat_lhs    :: LPat idL, 
     129        pat_rhs    :: GRHSs idR, 
     130        pat_rhs_ty :: PostTcType,       -- Type of the GRHSs 
     131        bind_fvs   :: NameSet           -- See Note [Bind free vars] 
    138132    } 
    139133 
    140   | VarBind {   -- Dictionary binding and suchlike  
    141         var_id     :: idL,           -- All VarBinds are introduced by the type checker 
    142         var_rhs    :: LHsExpr idR,   -- Located only for consistency 
    143         var_inline :: Bool           -- True <=> inline this binding regardless 
    144                                      -- (used for implication constraints only) 
     134  | VarBind {   -- Dictionary binding and suchlike 
     135        var_id     :: idL,           -- All VarBinds are introduced by the type checker 
     136        var_rhs    :: LHsExpr idR,   -- Located only for consistency 
     137        var_inline :: Bool           -- True <=> inline this binding regardless 
     138                                     -- (used for implication constraints only) 
    145139    } 
    146140 
    147   | AbsBinds {                          -- Binds abstraction; TRANSLATION 
    148         abs_tvs     :: [TyVar],   
    149         abs_ev_vars :: [EvVar], -- Includes equality constraints 
     141  | AbsBinds {                          -- Binds abstraction; TRANSLATION 
     142        abs_tvs     :: [TyVar], 
     143        abs_ev_vars :: [EvVar], -- Includes equality constraints 
    150144 
    151145       -- AbsBinds only gets used when idL = idR after renaming, 
    152        -- but these need to be idL's for the collect... code in HsUtil  
     146       -- but these need to be idL's for the collect... code in HsUtil 
    153147       -- to have the right type 
    154         abs_exports :: [ABExport idL], 
     148        abs_exports :: [ABExport idL], 
    155149 
    156150        abs_ev_binds :: TcEvBinds,     -- Evidence bindings 
    157         abs_binds    :: LHsBinds idL   -- Typechecked user bindings 
     151        abs_binds    :: LHsBinds idL   -- Typechecked user bindings 
    158152    } 
    159153 
    160154  deriving (Data, Typeable) 
    161         -- Consider (AbsBinds tvs ds [(ftvs, poly_f, mono_f) binds] 
    162         --  
    163         -- Creates bindings for (polymorphic, overloaded) poly_f 
    164         -- in terms of monomorphic, non-overloaded mono_f 
    165         -- 
    166         -- Invariants:  
    167         --      1. 'binds' binds mono_f 
    168         --      2. ftvs is a subset of tvs 
    169         --      3. ftvs includes all tyvars free in ds 
    170         -- 
    171         -- See section 9 of static semantics paper for more details. 
    172         -- (You can get a PhD for explaining the True Meaning 
    173         --  of this last construct.) 
    174  
    175 data ABExport id  
    176   = ABE { abe_poly  :: id  
    177         , abe_mono  :: id  
     155        -- Consider (AbsBinds tvs ds [(ftvs, poly_f, mono_f) binds] 
     156        -- 
     157        -- Creates bindings for (polymorphic, overloaded) poly_f 
     158        -- in terms of monomorphic, non-overloaded mono_f 
     159        -- 
     160        -- Invariants: 
     161        --      1. 'binds' binds mono_f 
     162        --      2. ftvs is a subset of tvs 
     163        --      3. ftvs includes all tyvars free in ds 
     164        -- 
     165        -- See section 9 of static semantics paper for more details. 
     166        -- (You can get a PhD for explaining the True Meaning 
     167        --  of this last construct.) 
     168 
     169data ABExport id 
     170  = ABE { abe_poly  :: id 
     171        , abe_mono  :: id 
    178172        , abe_wrap  :: HsWrapper  -- See Note [AbsBinds wrappers] 
    179173             -- Shape: (forall abs_tvs. abs_ev_vars => abe_mono) ~ abe_poly 
    180174        , abe_prags :: TcSpecPrags } 
    This ultimately desugars to something like this: 
    193187   tup :: forall a b. (a->a, b->b) 
    194188   tup = /\a b. (\x:a.x, \y:b.y) 
    195189   f :: forall a. a -> a 
    196    f = /\a. case tup a Any of  
     190   f = /\a. case tup a Any of 
    197191               (fm::a->a,gm:Any->Any) -> fm 
    198192   ...similarly for g... 
    199193 
    a) Dependency analysis prior to type checking 
    213207b) Deciding whether we can do generalisation of the binding 
    214208    (see TcBinds.decideGeneralisationPlan) 
    215209 
    216 Specifically,  
     210Specifically, 
    217211 
    218212  * bind_fvs includes all free vars that are defined in this module 
    219213    (including top-level things and lexically scoped type variables) 
    instance (OutputableBndr idL, OutputableBndr idR) => Outputable (HsValBindsLR id 
    233227  ppr (ValBindsIn binds sigs) 
    234228   = pprDeclList (pprLHsBindsForUser binds sigs) 
    235229 
    236   ppr (ValBindsOut sccs sigs)  
     230  ppr (ValBindsOut sccs sigs) 
    237231    = getPprStyle $ \ sty -> 
    238       if debugStyle sty then    -- Print with sccs showing 
    239         vcat (map ppr sigs) $$ vcat (map ppr_scc sccs) 
     232      if debugStyle sty then    -- Print with sccs showing 
     233        vcat (map ppr sigs) $$ vcat (map ppr_scc sccs) 
    240234     else 
    241         pprDeclList (pprLHsBindsForUser (unionManyBags (map snd sccs)) sigs) 
     235        pprDeclList (pprLHsBindsForUser (unionManyBags (map snd sccs)) sigs) 
    242236   where 
    243237     ppr_scc (rec_flag, binds) = pp_rec rec_flag <+> pprLHsBinds binds 
    244238     pp_rec Recursive    = ptext (sLit "rec") 
    245239     pp_rec NonRecursive = ptext (sLit "nonrec") 
    246240 
    247241pprLHsBinds :: (OutputableBndr idL, OutputableBndr idR) => LHsBindsLR idL idR -> SDoc 
    248 pprLHsBinds binds  
     242pprLHsBinds binds 
    249243  | isEmptyLHsBinds binds = empty 
    250244  | otherwise = pprDeclList (map ppr (bagToList binds)) 
    251245 
    252246pprLHsBindsForUser :: (OutputableBndr idL, OutputableBndr idR, OutputableBndr id2) 
    253                    => LHsBindsLR idL idR -> [LSig id2] -> [SDoc] 
    254 --  pprLHsBindsForUser is different to pprLHsBinds because  
     247                   => LHsBindsLR idL idR -> [LSig id2] -> [SDoc] 
     248--  pprLHsBindsForUser is different to pprLHsBinds because 
    255249--  a) No braces: 'let' and 'where' include a list of HsBindGroups 
    256 --     and we don't want several groups of bindings each  
     250--     and we don't want several groups of bindings each 
    257251--     with braces around 
    258252--  b) Sort by location before printing 
    259253--  c) Include signatures 
    pprLHsBindsForUser binds sigs 
    263257 
    264258    decls :: [(SrcSpan, SDoc)] 
    265259    decls = [(loc, ppr sig)  | L loc sig <- sigs] ++ 
    266             [(loc, ppr bind) | L loc bind <- bagToList binds] 
     260            [(loc, ppr bind) | L loc bind <- bagToList binds] 
    267261 
    268262    sort_by_loc decls = sortLe (\(l1,_) (l2,_) -> l1 <= l2) decls 
    269263 
    pprDeclList :: [SDoc] -> SDoc -- Braces with a space 
    272266-- One could choose  { d1; d2; ... }, using 'sep' 
    273267-- or      d1 
    274268--         d2 
    275 --         .. 
     269--         .. 
    276270--    using vcat 
    277271-- At the moment we chose the latter 
    278272-- Also we do the 'pprDeeperList' thing. 
    plusHsValBinds (ValBindsIn ds1 sigs1) (ValBindsIn ds2 sigs2) 
    307301  = ValBindsIn (ds1 `unionBags` ds2) (sigs1 ++ sigs2) 
    308302plusHsValBinds (ValBindsOut ds1 sigs1) (ValBindsOut ds2 sigs2) 
    309303  = ValBindsOut (ds1 ++ ds2) (sigs1 ++ sigs2) 
     304plusHsValBinds _ _ 
     305  = panic "HsBinds.plusHsValBinds" 
    310306 
    311307getTypeSigNames :: HsValBinds a -> NameSet 
    312308-- Get the names that have a user type sig 
    313 getTypeSigNames (ValBindsIn {})  
    314   = panic "getTypeSigNames" 
    315 getTypeSigNames (ValBindsOut _ sigs)  
     309getTypeSigNames (ValBindsOut _ sigs) 
    316310  = mkNameSet [unLoc n | L _ (TypeSig names _) <- sigs, n <- names] 
     311getTypeSigNames _ 
     312  = panic "HsBinds.getTypeSigNames" 
    317313\end{code} 
    318314 
    319315What AbsBinds means 
    320316~~~~~~~~~~~~~~~~~~~ 
    321         AbsBinds tvs 
    322                   [d1,d2] 
    323                   [(tvs1, f1p, f1m),  
    324                    (tvs2, f2p, f2m)] 
    325                   BIND 
     317        AbsBinds tvs 
     318                  [d1,d2] 
     319                  [(tvs1, f1p, f1m), 
     320                   (tvs2, f2p, f2m)] 
     321                  BIND 
    326322means 
    327323 
    328         f1p = /\ tvs -> \ [d1,d2] -> letrec DBINDS and BIND  
    329                                       in fm 
     324        f1p = /\ tvs -> \ [d1,d2] -> letrec DBINDS and BIND 
     325                                     in fm 
    330326 
    331         gp = ...same again, with gm instead of fm 
     327        gp = ...same again, with gm instead of fm 
    332328 
    333329This is a pretty bad translation, because it duplicates all the bindings. 
    334330So the desugarer tries to do a better job: 
    335331 
    336         fp = /\ [a,b] -> \ [d1,d2] -> case tp [a,b] [d1,d2] of 
    337                                         (fm,gm) -> fm 
    338         ..ditto for gp.. 
     332        fp = /\ [a,b] -> \ [d1,d2] -> case tp [a,b] [d1,d2] of 
     333                                        (fm,gm) -> fm 
     334        ..ditto for gp.. 
    339335 
    340         tp = /\ [a,b] -> \ [d1,d2] -> letrec DBINDS and BIND  
    341                                        in (fm,gm) 
     336        tp = /\ [a,b] -> \ [d1,d2] -> letrec DBINDS and BIND 
     337                                      in (fm,gm) 
    342338 
    343339\begin{code} 
    344340instance (OutputableBndr idL, OutputableBndr idR) => Outputable (HsBindLR idL idR) where 
    ppr_monobind :: (OutputableBndr idL, OutputableBndr idR) => HsBindLR idL idR -> 
    348344 
    349345ppr_monobind (PatBind { pat_lhs = pat, pat_rhs = grhss }) 
    350346  = pprPatBind pat grhss 
    351 ppr_monobind (VarBind { var_id = var, var_rhs = rhs })     
     347ppr_monobind (VarBind { var_id = var, var_rhs = rhs }) 
    352348  = sep [pprBndr CaseBind var, nest 2 $ equals <+> pprExpr (unLoc rhs)] 
    353349ppr_monobind (FunBind { fun_id = fun, fun_infix = inf, 
    354                         fun_co_fn = wrap,  
    355                         fun_matches = matches, 
    356                         fun_tick = tick }) 
    357   = pprTicks empty (case tick of  
    358                         Nothing -> empty 
    359                         Just t  -> text "-- tick id = " <> ppr t) 
     350                        fun_co_fn = wrap, 
     351                        fun_matches = matches, 
     352                        fun_tick = tick }) 
     353  = pprTicks empty (case tick of 
     354                        Nothing -> empty 
     355                        Just t  -> text "-- tick id = " <> ppr t) 
    360356    $$  ifPprDebug (pprBndr LetBind (unLoc fun)) 
    361357    $$  pprFunBind (unLoc fun) inf matches 
    362358    $$  ifPprDebug (ppr wrap) 
    ppr_monobind (AbsBinds { abs_tvs = tyvars, abs_ev_vars = dictvars 
    365361                       , abs_exports = exports, abs_binds = val_binds 
    366362                       , abs_ev_binds = ev_binds }) 
    367363  = sep [ptext (sLit "AbsBinds"), 
    368         brackets (interpp'SP tyvars), 
    369         brackets (interpp'SP dictvars), 
    370         brackets (sep (punctuate comma (map ppr exports)))] 
     364        brackets (interpp'SP tyvars), 
     365        brackets (interpp'SP dictvars), 
     366        brackets (sep (punctuate comma (map ppr exports)))] 
    371367    $$ 
    372368    nest 2 ( vcat [pprBndr LetBind (abe_poly ex) | ex <- exports] 
    373                         -- Print type signatures 
    374              $$ pprLHsBinds val_binds ) 
     369                        -- Print type signatures 
     370             $$ pprLHsBinds val_binds ) 
    375371    $$ 
    376372    ifPprDebug (ppr ev_binds) 
    377373 
    378374instance (OutputableBndr id) => Outputable (ABExport id) where 
    379375  ppr (ABE { abe_wrap = wrap, abe_poly = gbl, abe_mono = lcl, abe_prags = prags }) 
    380376    = vcat [ ppr gbl <+> ptext (sLit "<=") <+> ppr lcl 
    381            , nest 2 (pprTcSpecPrags prags) 
     377           , nest 2 (pprTcSpecPrags prags) 
    382378           , nest 2 (ppr wrap)] 
    383379\end{code} 
    384380 
    pprTicks :: SDoc -> SDoc -> SDoc 
    388384-- Print stuff about ticks only when -dppr-debug is on, to avoid 
    389385-- them appearing in error messages (from the desugarer); see Trac # 3263 
    390386pprTicks pp_no_debug pp_when_debug 
    391   = getPprStyle (\ sty -> if debugStyle sty then pp_when_debug  
     387  = getPprStyle (\ sty -> if debugStyle sty then pp_when_debug 
    392388                                            else pp_no_debug) 
    393389\end{code} 
    394390 
    395391%************************************************************************ 
    396 %*                                                                      * 
    397                 Implicit parameter bindings 
    398 %*                                                                      * 
     392%*                                                                      * 
     393                Implicit parameter bindings 
     394%*                                                                      * 
    399395%************************************************************************ 
    400396 
    401397\begin{code} 
    402398data HsIPBinds id 
    403   = IPBinds  
    404         [LIPBind id]  
    405         TcEvBinds       -- Only in typechecker output; binds  
    406                         -- uses of the implicit parameters 
     399  = IPBinds 
     400        [LIPBind id] 
     401        TcEvBinds       -- Only in typechecker output; binds 
     402                        -- uses of the implicit parameters 
    407403  deriving (Data, Typeable) 
    408404 
    409405isEmptyIPBinds :: HsIPBinds id -> Bool 
    type LIPBind id = Located (IPBind id) 
    414410-- | Implicit parameter bindings. 
    415411data IPBind id 
    416412  = IPBind 
    417         (IPName id) 
    418         (LHsExpr id) 
     413        (IPName id) 
     414        (LHsExpr id) 
    419415  deriving (Data, Typeable) 
    420416 
    421417instance (OutputableBndr id) => Outputable (HsIPBinds id) where 
    422   ppr (IPBinds bs ds) = pprDeeperList vcat (map ppr bs)  
     418  ppr (IPBinds bs ds) = pprDeeperList vcat (map ppr bs) 
    423419                        $$ ifPprDebug (ppr ds) 
    424420 
    425421instance (OutputableBndr id) => Outputable (IPBind id) where 
    instance (OutputableBndr id) => Outputable (IPBind id) where 
    428424 
    429425 
    430426%************************************************************************ 
    431 %*                                                                      * 
     427%*                                                                      * 
    432428\subsection{Coercion functions} 
    433 %*                                                                      * 
     429%*                                                                      * 
    434430%************************************************************************ 
    435431 
    436432\begin{code} 
    437433data HsWrapper 
    438   = WpHole                      -- The identity coercion 
     434  = WpHole                      -- The identity coercion 
    439435 
    440   | WpCompose HsWrapper HsWrapper        
     436  | WpCompose HsWrapper HsWrapper 
    441437       -- (wrap1 `WpCompose` wrap2)[e] = wrap1[ wrap2[ e ]] 
    442        --  
     438       -- 
    443439       -- Hence  (\a. []) `WpCompose` (\b. []) = (\a b. []) 
    444440       -- But    ([] a)   `WpCompose` ([] b)   = ([] b a) 
    445441 
    446442  | WpCast LCoercion          -- A cast:  [] `cast` co 
    447443                              -- Guaranteed not the identity coercion 
    448444 
    449         -- Evidence abstraction and application 
     445        -- Evidence abstraction and application 
    450446        -- (both dictionaries and coercions) 
    451   | WpEvLam EvVar               -- \d. []       the 'd' is an evidence variable 
    452   | WpEvApp EvTerm              -- [] d         the 'd' is evidence for a constraint 
     447  | WpEvLam EvVar               -- \d. []       the 'd' is an evidence variable 
     448  | WpEvApp EvTerm              -- [] d         the 'd' is evidence for a constraint 
    453449 
    454         -- Type abstraction and application 
    455   | WpTyLam TyVar               -- \a. []       the 'a' is a type variable (not coercion var) 
    456   | WpTyApp Type                -- [] t         the 't' is a type (not coercion) 
     450        -- Type abstraction and application 
     451  | WpTyLam TyVar               -- \a. []       the 'a' is a type variable (not coercion var) 
     452  | WpTyApp Type                -- [] t         the 't' is a type (not coercion) 
    457453 
    458454 
    459   | WpLet TcEvBinds             -- Non-empty (or possibly non-empty) evidence bindings, 
     455  | WpLet TcEvBinds             -- Non-empty (or possibly non-empty) evidence bindings, 
    460456                                -- so that the identity coercion is always exactly WpHole 
    461457  deriving (Data, Typeable) 
    462458 
    463459 
    464 data TcEvBinds  
    465   = TcEvBinds           -- Mutable evidence bindings 
    466        EvBindsVar       -- Mutable because they are updated "later" 
    467                         --    when an implication constraint is solved 
     460data TcEvBinds 
     461  = TcEvBinds           -- Mutable evidence bindings 
     462       EvBindsVar       -- Mutable because they are updated "later" 
     463                        --    when an implication constraint is solved 
    468464 
    469   | EvBinds             -- Immutable after zonking 
     465  | EvBinds             -- Immutable after zonking 
    470466       (Bag EvBind) 
    471467 
    472468  deriving( Typeable ) 
    instance Data TcEvBinds where 
    500496data EvBind = EvBind EvVar EvTerm 
    501497 
    502498data EvTerm 
    503   = EvId EvId                  -- Term-level variable-to-variable bindings  
     499  = EvId EvId                  -- Term-level variable-to-variable bindings 
    504500                               -- (no coercion variables! they come via EvCoercionBox) 
    505501 
    506502  | EvCoercionBox LCoercion    -- (Boxed) coercion bindings 
    data EvTerm 
    516512 
    517513  | EvSuperClass DictId Int    -- n'th superclass. Used for both equalities and 
    518514                               -- dictionaries, even though the former have no 
    519                                -- selector Id.  We count up from _0_  
    520                                 
     515                               -- selector Id.  We count up from _0_ 
     516 
    521517  deriving( Data, Typeable) 
    522518\end{code} 
    523519 
    524520Note [EvBinds/EvTerm] 
    525521~~~~~~~~~~~~~~~~~~~~~ 
    526 How evidence is created and updated. Bindings for dictionaries,  
     522How evidence is created and updated. Bindings for dictionaries, 
    527523and coercions and implicit parameters are carried around in TcEvBinds 
    528524which during constraint generation and simplification is always of the 
    529 form (TcEvBinds ref). After constraint simplification is finished it  
    530 will be transformed to t an (EvBinds ev_bag).  
     525form (TcEvBinds ref). After constraint simplification is finished it 
     526will be transformed to t an (EvBinds ev_bag). 
    531527 
    532 Evidence for coercions *SHOULD* be filled in using the TcEvBinds  
    533 However, all EvVars that correspond to *wanted* coercion terms in  
    534 an EvBind must be mutable variables so that they can be readily  
     528Evidence for coercions *SHOULD* be filled in using the TcEvBinds 
     529However, all EvVars that correspond to *wanted* coercion terms in 
     530an EvBind must be mutable variables so that they can be readily 
    535531inlined (by zonking) after constraint simplification is finished. 
    536532 
    537 Conclusion: a new wanted coercion variable should be made mutable.  
    538 [Notice though that evidence variables that bind coercion terms  
    539  from super classes will be "given" and hence rigid]  
     533Conclusion: a new wanted coercion variable should be made mutable. 
     534[Notice though that evidence variables that bind coercion terms 
     535 from super classes will be "given" and hence rigid] 
    540536 
    541537 
    542538\begin{code} 
    emptyTcEvBinds = EvBinds emptyBag 
    546542isEmptyTcEvBinds :: TcEvBinds -> Bool 
    547543isEmptyTcEvBinds (EvBinds b)    = isEmptyBag b 
    548544isEmptyTcEvBinds (TcEvBinds {}) = panic "isEmptyTcEvBinds" 
    549   
     545 
    550546(<.>) :: HsWrapper -> HsWrapper -> HsWrapper 
    551547WpHole <.> c = c 
    552548c <.> WpHole = c 
    isIdHsWrapper _ = False 
    591587Pretty printing 
    592588 
    593589\begin{code} 
    594 instance Outputable HsWrapper where  
     590instance Outputable HsWrapper where 
    595591  ppr co_fn = pprHsWrapper (ptext (sLit "<>")) co_fn 
    596592 
    597593pprHsWrapper :: SDoc -> HsWrapper -> SDoc 
    pprHsWrapper doc wrap 
    605601    -- False <=> appears as body of let or lambda 
    606602    help it WpHole             = it 
    607603    help it (WpCompose f1 f2)  = help (help it f2) f1 
    608     help it (WpCast co)   = add_parens $ sep [it False, nest 2 (ptext (sLit "|>")  
     604    help it (WpCast co)   = add_parens $ sep [it False, nest 2 (ptext (sLit "|>") 
    609605                                              <+> pprParendCo co)] 
    610606    help it (WpEvApp id)  = no_parens  $ sep [it True, nest 2 (ppr id)] 
    611607    help it (WpTyApp ty)  = no_parens  $ sep [it True, ptext (sLit "@") <+> pprParendType ty] 
    instance Outputable EvBind where 
    632628   -- We cheat a bit and pretend EqVars are CoVars for the purposes of pretty printing 
    633629 
    634630instance Outputable EvTerm where 
    635   ppr (EvId v)          = ppr v 
     631  ppr (EvId v)          = ppr v 
    636632  ppr (EvCast v co)      = ppr v <+> (ptext (sLit "`cast`")) <+> pprParendCo co 
    637633  ppr (EvCoercionBox co) = ptext (sLit "CO") <+> ppr co 
    638634  ppr (EvTupleSel v n)   = ptext (sLit "tupsel") <> parens (ppr (v,n)) 
    instance Outputable EvTerm where 
    642638\end{code} 
    643639 
    644640%************************************************************************ 
    645 %*                                                                      * 
     641%*                                                                      * 
    646642\subsection{@Sig@: type signatures and value-modifying user pragmas} 
    647 %*                                                                      * 
     643%*                                                                      * 
    648644%************************************************************************ 
    649645 
    650646It is convenient to lump ``value-modifying'' user-pragmas (e.g., 
    serves for both. 
    655651\begin{code} 
    656652type LSig name = Located (Sig name) 
    657653 
    658 data Sig name   -- Signatures and pragmas 
    659   =     -- An ordinary type signature 
    660         -- f :: Num a => a -> a 
     654data Sig name   -- Signatures and pragmas 
     655  =     -- An ordinary type signature 
     656        -- f :: Num a => a -> a 
    661657    TypeSig [Located name] (LHsType name) 
    662658 
    663659        -- A type signature for a default method inside a class 
    664660        -- default eq :: (Representable0 a, GEq (Rep0 a)) => a -> a -> Bool 
    665661  | GenericSig [Located name] (LHsType name) 
    666662 
    667         -- A type signature in generated code, notably the code 
    668         -- generated for record selectors.  We simply record 
    669         -- the desired Id itself, replete with its name, type 
    670         -- and IdDetails.  Otherwise it's just like a type  
    671         -- signature: there should be an accompanying binding 
     663        -- A type signature in generated code, notably the code 
     664        -- generated for record selectors.  We simply record 
     665        -- the desired Id itself, replete with its name, type 
     666        -- and IdDetails.  Otherwise it's just like a type 
     667        -- signature: there should be an accompanying binding 
    672668  | IdSig Id 
    673669 
    674         -- An ordinary fixity declaration 
    675         --      infixl *** 8 
     670        -- An ordinary fixity declaration 
     671        --      infixl *** 8 
    676672  | FixSig (FixitySig name) 
    677673 
    678         -- An inline pragma 
    679         -- {#- INLINE f #-} 
    680   | InlineSig   (Located name)  -- Function name 
    681                 InlinePragma    -- Never defaultInlinePragma 
     674        -- An inline pragma 
     675        -- {#- INLINE f #-} 
     676  | InlineSig   (Located name)  -- Function name 
     677                InlinePragma    -- Never defaultInlinePragma 
    682678 
    683         -- A specialisation pragma 
    684         -- {-# SPECIALISE f :: Int -> Int #-} 
    685   | SpecSig     (Located name)  -- Specialise a function or datatype ... 
    686                 (LHsType name)  -- ... to these types 
    687                 InlinePragma    -- The pragma on SPECIALISE_INLINE form 
    688                                 -- If it's just defaultInlinePragma, then we said 
    689                                 --    SPECIALISE, not SPECIALISE_INLINE 
     679        -- A specialisation pragma 
     680        -- {-# SPECIALISE f :: Int -> Int #-} 
     681  | SpecSig     (Located name)  -- Specialise a function or datatype ... 
     682                (LHsType name)  -- ... to these types 
     683                InlinePragma    -- The pragma on SPECIALISE_INLINE form 
     684                                -- If it's just defaultInlinePragma, then we said 
     685                                --    SPECIALISE, not SPECIALISE_INLINE 
    690686 
    691687        -- A specialisation pragma for instance declarations only 
    692688        -- {-# SPECIALISE instance Eq [Int] #-} 
    693   | SpecInstSig (LHsType name)  -- (Class tys); should be a specialisation of the  
     689  | SpecInstSig (LHsType name)  -- (Class tys); should be a specialisation of the 
    694690                                -- current instance decl 
    695691  deriving (Data, Typeable) 
    696692 
    697693 
    698694type LFixitySig name = Located (FixitySig name) 
    699 data FixitySig name = FixitySig (Located name) Fixity  
     695data FixitySig name = FixitySig (Located name) Fixity 
    700696  deriving (Data, Typeable) 
    701697 
    702698-- TsSpecPrags conveys pragmas from the type checker to the desugarer 
    703 data TcSpecPrags  
    704   = IsDefaultMethod     -- Super-specialised: a default method should  
    705                         -- be macro-expanded at every call site 
     699data TcSpecPrags 
     700  = IsDefaultMethod     -- Super-specialised: a default method should 
     701                        -- be macro-expanded at every call site 
    706702  | SpecPrags [LTcSpecPrag] 
    707703  deriving (Data, Typeable) 
    708704 
    709705type LTcSpecPrag = Located TcSpecPrag 
    710706 
    711 data TcSpecPrag  
    712   = SpecPrag    
    713         Id              -- The Id to be specialised 
    714         HsWrapper       -- An wrapper, that specialises the polymorphic function 
    715         InlinePragma    -- Inlining spec for the specialised function 
     707data TcSpecPrag 
     708  = SpecPrag 
     709        Id              -- The Id to be specialised 
     710        HsWrapper       -- An wrapper, that specialises the polymorphic function 
     711        InlinePragma    -- Inlining spec for the specialised function 
    716712  deriving (Data, Typeable) 
    717713 
    718714noSpecPrags :: TcSpecPrags 
    isDefaultMethod (SpecPrags {}) = False 
    731727\begin{code} 
    732728isFixityLSig :: LSig name -> Bool 
    733729isFixityLSig (L _ (FixSig {})) = True 
    734 isFixityLSig _                 = False 
     730isFixityLSig _                 = False 
    735731 
    736 isVanillaLSig :: LSig name -> Bool      -- User type signatures 
     732isVanillaLSig :: LSig name -> Bool      -- User type signatures 
    737733-- A badly-named function, but it's part of the GHCi (used 
    738734-- by Haddock) so I don't want to change it gratuitously. 
    739735isVanillaLSig (L _(TypeSig {})) = True 
    740736isVanillaLSig _                 = False 
    741737 
    742 isTypeLSig :: LSig name -> Bool  -- Type signatures 
     738isTypeLSig :: LSig name -> Bool  -- Type signatures 
    743739isTypeLSig (L _(TypeSig {}))    = True 
    744740isTypeLSig (L _(GenericSig {})) = True 
    745741isTypeLSig (L _(IdSig {}))      = True 
    isSpecInstLSig (L _ (SpecInstSig {})) = True 
    754750isSpecInstLSig _                      = False 
    755751 
    756752isPragLSig :: LSig name -> Bool 
    757         -- Identifies pragmas  
     753-- Identifies pragmas 
    758754isPragLSig (L _ (SpecSig {}))   = True 
    759755isPragLSig (L _ (InlineSig {})) = True 
    760756isPragLSig _                    = False 
    761757 
    762758isInlineLSig :: LSig name -> Bool 
    763         -- Identifies inline pragmas  
     759-- Identifies inline pragmas 
    764760isInlineLSig (L _ (InlineSig {})) = True 
    765761isInlineLSig _                    = False 
    766762 
    767763hsSigDoc :: Sig name -> SDoc 
    768 hsSigDoc (TypeSig {})           = ptext (sLit "type signature") 
    769 hsSigDoc (GenericSig {})        = ptext (sLit "default type signature") 
    770 hsSigDoc (IdSig {})             = ptext (sLit "id signature") 
    771 hsSigDoc (SpecSig {})           = ptext (sLit "SPECIALISE pragma") 
     764hsSigDoc (TypeSig {})           = ptext (sLit "type signature") 
     765hsSigDoc (GenericSig {})        = ptext (sLit "default type signature") 
     766hsSigDoc (IdSig {})             = ptext (sLit "id signature") 
     767hsSigDoc (SpecSig {})           = ptext (sLit "SPECIALISE pragma") 
    772768hsSigDoc (InlineSig {})         = ptext (sLit "INLINE pragma") 
    773 hsSigDoc (SpecInstSig {})       = ptext (sLit "SPECIALISE instance pragma") 
    774 hsSigDoc (FixSig {})            = ptext (sLit "fixity declaration") 
     769hsSigDoc (SpecInstSig {})       = ptext (sLit "SPECIALISE instance pragma") 
     770hsSigDoc (FixSig {})            = ptext (sLit "fixity declaration") 
    775771\end{code} 
    776772 
    777773Check if signatures overlap; this is used when checking for duplicate 
    instance (OutputableBndr name) => Outputable (Sig name) where 
    799795    ppr sig = ppr_sig sig 
    800796 
    801797ppr_sig :: OutputableBndr name => Sig name -> SDoc 
    802 ppr_sig (TypeSig vars ty)         = pprVarSig (map unLoc vars) (ppr ty) 
    803 ppr_sig (GenericSig vars ty)      = ptext (sLit "default") <+> pprVarSig (map unLoc vars) (ppr ty) 
    804 ppr_sig (IdSig id)                = pprVarSig [id] (ppr (varType id)) 
    805 ppr_sig (FixSig fix_sig)          = ppr fix_sig 
    806 ppr_sig (SpecSig var ty inl)      = pragBrackets (pprSpec var (ppr ty) inl) 
     798ppr_sig (TypeSig vars ty)         = pprVarSig (map unLoc vars) (ppr ty) 
     799ppr_sig (GenericSig vars ty)      = ptext (sLit "default") <+> pprVarSig (map unLoc vars) (ppr ty) 
     800ppr_sig (IdSig id)                = pprVarSig [id] (ppr (varType id)) 
     801ppr_sig (FixSig fix_sig)          = ppr fix_sig 
     802ppr_sig (SpecSig var ty inl)      = pragBrackets (pprSpec var (ppr ty) inl) 
    807803ppr_sig (InlineSig var inl)       = pragBrackets (ppr inl <+> ppr var) 
    808 ppr_sig (SpecInstSig ty)          = pragBrackets (ptext (sLit "SPECIALIZE instance") <+> ppr ty) 
     804ppr_sig (SpecInstSig ty)          = pragBrackets (ptext (sLit "SPECIALIZE instance") <+> ppr ty) 
    809805 
    810806instance Outputable name => Outputable (FixitySig name) where 
    811807  ppr (FixitySig name fixity) = sep [ppr fixity, ppr name] 
    812808 
    813809pragBrackets :: SDoc -> SDoc 
    814 pragBrackets doc = ptext (sLit "{-#") <+> doc <+> ptext (sLit "#-}")  
     810pragBrackets doc = ptext (sLit "{-#") <+> doc <+> ptext (sLit "#-}") 
    815811 
    816812pprVarSig :: (Outputable id) => [id] -> SDoc -> SDoc 
    817813pprVarSig vars pp_ty = sep [pprvars <+> dcolon, nest 2 pp_ty] 
    pprTcSpecPrags (SpecPrags ps) = vcat (map (ppr . unLoc) ps) 
    831827instance Outputable TcSpecPrag where 
    832828  ppr (SpecPrag var _ inl) = pprSpec var (ptext (sLit "<type>")) inl 
    833829\end{code} 
    834