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, 4 years ago)

Additional cleanup in HsBinds.

  • compiler/hsSyn/HsBinds.lhs

    From 67da94b7d5b3e736010bb4de46b7d4064045ff7d Mon Sep 17 00:00:00 2001
    From: Michal Terepeta <[email protected]>
    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