compiler/hsSyn/HsBinds.lhs

   1 %
   2 % (c) The University of Glasgow 2006
   3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   4 %
   5 \section[HsBinds]{Abstract syntax: top-level bindings and signatures}
   6
   7 Datatype for: @BindGroup@, @Bind@, @Sig@, @Bind@.
   8
   9 \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
  16
  17 module HsBinds where
  18
  19 import {-# SOURCE #-} HsExpr ( HsExpr, pprExpr, LHsExpr,
  20                                MatchGroup, pprFunBind,
  21                                GRHSs, pprPatBind )
  22 import {-# SOURCE #-} HsPat  ( LPat )
  23
  24 import HsTypes
  25 import PprCore ()
  26 import Coercion
  27 import Type
  28 import Name
  29 import NameSet
  30 import BasicTypes
  31 import Outputable
  32 import SrcLoc
  33 import Util
  34 import Var
  35 import Bag
  36 import FastString
  37 \end{code}
  38
  39 %************************************************************************
  40 %*                                                                      *
  41 \subsection{Bindings: @BindGroup@}
  42 %*                                                                      *
  43 %************************************************************************
  44
  45 Global bindings (where clauses)
  46
  47 \begin{code}
  48 -- During renaming, we need bindings where the left-hand sides
  49 -- have been renamed but the the right-hand sides have not.
  50 -- the ...LR datatypes are parametrized by two id types,
  51 -- one for the left and one for the right.
  52 -- Other than during renaming, these will be the same.
  53
  54 type HsLocalBinds id = HsLocalBindsLR id id
  55
  56 data HsLocalBindsLR idL idR     -- Bindings in a 'let' expression
  57                                -- or a 'where' clause
  58   = HsValBinds (HsValBindsLR idL idR)
  59   | HsIPBinds  (HsIPBinds idR)
  60   | EmptyLocalBinds
  61
  62 type HsValBinds id = HsValBindsLR id id
  63
  64 data HsValBindsLR idL idR  -- Value bindings (not implicit parameters)
  65   = ValBindsIn             -- Before typechecking
  66         (LHsBindsLR idL idR) [LSig idR] -- Not dependency analysed
  67                                         -- Recursive by default
  68
  69   | ValBindsOut                -- After renaming
  70         [(RecFlag, LHsBinds idL)]       -- Dependency analysed, later bindings
  71                                         -- in the list may depend on earlier
  72                                         -- ones.
  73         [LSig Name]
  74
  75 type LHsBinds id  = Bag (LHsBind id)
  76 type DictBinds id = LHsBinds id         -- Used for dictionary or method bindings
  77 type LHsBind  id  = Located (HsBind id)
  78 type HsBind id = HsBindLR id id
  79
  80 type LHsBindLR idL idR = Located (HsBindLR idL idR)
  81 type LHsBindsLR idL idR = Bag (LHsBindLR idL idR)
  82
  83 data HsBindLR idL idR
  84   = FunBind {   -- FunBind is used for both functions   f x = e
  85                 -- and variables                        f = \x -> e
  86 -- Reason 1: Special case for type inference: see TcBinds.tcMonoBinds
  87 --
  88 -- Reason 2: instance decls can only have FunBinds, which is convenient
  89 --           If you change this, you'll need to change e.g. rnMethodBinds
  90
  91 -- But note that the form       f :: a->a = ...
  92 -- parses as a pattern binding, just like
  93 --                      (f :: a -> a) = ...
  94
  95         fun_id :: Located idL,
  96
  97         fun_infix :: Bool,      -- True => infix declaration
  98
  99         fun_matches :: MatchGroup idR,  -- The payload
 100
 101         fun_co_fn :: HsWrapper, -- Coercion from the type of the MatchGroup to the type of
 102                                 -- the Id.  Example:
 103                                 --      f :: Int -> forall a. a -> a
 104                                 --      f x y = y
 105                                 -- Then the MatchGroup will have type (Int -> a' -> a')
 106                                 -- (with a free type variable a').  The coercion will take
 107                                 -- a CoreExpr of this type and convert it to a CoreExpr of
 108                                 -- type         Int -> forall a'. a' -> a'
 109                                 -- Notice that the coercion captures the free a'.
 110
 111         bind_fvs :: NameSet,    -- After the renamer, this contains a superset of the
 112                                 -- Names of the other binders in this binding group that
 113                                 -- are free in the RHS of the defn
 114                                 -- Before renaming, and after typechecking,
 115                                 -- the field is unused; it's just an error thunk
 116
 117         fun_tick :: Maybe (Int,[idR])   -- This is the (optional) module-local tick number.
 118     }
 119
 120   | PatBind {   -- The pattern is never a simple variable;
 121                 -- That case is done by FunBind
 122         pat_lhs    :: LPat idL,
 123         pat_rhs    :: GRHSs idR,
 124         pat_rhs_ty :: PostTcType,       -- Type of the GRHSs
 125         bind_fvs   :: NameSet           -- Same as for FunBind
 126     }
 127
 128   | VarBind {   -- Dictionary binding and suchlike
 129         var_id :: idL,          -- All VarBinds are introduced by the type checker
 130         var_rhs :: LHsExpr idR  -- Located only for consistency
 131     }
 132
 133   | AbsBinds {                                  -- Binds abstraction; TRANSLATION
 134         abs_tvs     :: [TyVar],
 135         abs_dicts   :: [DictId],                -- Includes equality constraints
 136
 137        -- AbsBinds only gets used when idL = idR after renaming,
 138        -- but these need to be idL's for the collect... code in HsUtil to have
 139        -- the right type
 140         abs_exports :: [([TyVar], idL, idL, [LPrag])],  -- (tvs, poly_id, mono_id, prags)
 141         abs_binds   :: LHsBinds idL             -- The dictionary bindings and typechecked user bindings
 142                                                 -- mixed up together; you can tell the dict bindings because
 143                                                 -- they are all VarBinds
 144     }
 145         -- Consider (AbsBinds tvs ds [(ftvs, poly_f, mono_f) binds]
 146         --
 147         -- Creates bindings for (polymorphic, overloaded) poly_f
 148         -- in terms of monomorphic, non-overloaded mono_f
 149         --
 150         -- Invariants:
 151         --      1. 'binds' binds mono_f
 152         --      2. ftvs is a subset of tvs
 153         --      3. ftvs includes all tyvars free in ds
 154         --
 155         -- See section 9 of static semantics paper for more details.
 156         -- (You can get a PhD for explaining the True Meaning
 157         --  of this last construct.)
 158
 159 placeHolderNames :: NameSet
 160 -- Used for the NameSet in FunBind and PatBind prior to the renamer
 161 placeHolderNames = panic "placeHolderNames"
 162
 163 ------------
 164 instance (OutputableBndr idL, OutputableBndr idR) => Outputable (HsLocalBindsLR idL idR) where
 165   ppr (HsValBinds bs) = ppr bs
 166   ppr (HsIPBinds bs)  = ppr bs
 167   ppr EmptyLocalBinds = empty
 168
 169 instance (OutputableBndr idL, OutputableBndr idR) => Outputable (HsValBindsLR idL idR) where
 170   ppr (ValBindsIn binds sigs)
 171    = pprValBindsForUser binds sigs
 172
 173   ppr (ValBindsOut sccs sigs)
 174     = getPprStyle $ \ sty ->
 175       if debugStyle sty then    -- Print with sccs showing
 176         vcat (map ppr sigs) $$ vcat (map ppr_scc sccs)
 177      else
 178         pprValBindsForUser (unionManyBags (map snd sccs)) sigs
 179    where
 180      ppr_scc (rec_flag, binds) = pp_rec rec_flag <+> pprLHsBinds binds
 181      pp_rec Recursive    = ptext (sLit "rec")
 182      pp_rec NonRecursive = ptext (sLit "nonrec")
 183
 184 --  *not* pprLHsBinds because we don't want braces; 'let' and
 185 -- 'where' include a list of HsBindGroups and we don't want
 186 -- several groups of bindings each with braces around.
 187 -- Sort by location before printing
 188 pprValBindsForUser :: (OutputableBndr idL, OutputableBndr idR, OutputableBndr id2)
 189                    => LHsBindsLR idL idR -> [LSig id2] -> SDoc
 190 pprValBindsForUser binds sigs
 191   = pprDeeperList vcat (map snd (sort_by_loc decls))
 192   where
 193
 194     decls :: [(SrcSpan, SDoc)]
 195     decls = [(loc, ppr sig)  | L loc sig <- sigs] ++
 196              [(loc, ppr bind) | L loc bind <- bagToList binds]
 197
 198     sort_by_loc decls = sortLe (\(l1,_) (l2,_) -> l1 <= l2) decls
 199
 200 pprLHsBinds :: (OutputableBndr idL, OutputableBndr idR) => LHsBindsLR idL idR -> SDoc
 201 pprLHsBinds binds
 202   | isEmptyLHsBinds binds = empty
 203   | otherwise = lbrace <+> pprDeeperList vcat (map ppr (bagToList binds)) <+> rbrace
 204
 205 ------------
 206 emptyLocalBinds :: HsLocalBindsLR a b
 207 emptyLocalBinds = EmptyLocalBinds
 208
 209 isEmptyLocalBinds :: HsLocalBindsLR a b -> Bool
 210 isEmptyLocalBinds (HsValBinds ds) = isEmptyValBinds ds
 211 isEmptyLocalBinds (HsIPBinds ds)  = isEmptyIPBinds ds
 212 isEmptyLocalBinds EmptyLocalBinds = True
 213
 214 isEmptyValBinds :: HsValBindsLR a b -> Bool
 215 isEmptyValBinds (ValBindsIn ds sigs)  = isEmptyLHsBinds ds && null sigs
 216 isEmptyValBinds (ValBindsOut ds sigs) = null ds && null sigs
 217
 218 emptyValBindsIn, emptyValBindsOut :: HsValBindsLR a b
 219 emptyValBindsIn  = ValBindsIn emptyBag []
 220 emptyValBindsOut = ValBindsOut []      []
 221
 222 emptyLHsBinds :: LHsBindsLR idL idR
 223 emptyLHsBinds = emptyBag
 224
 225 isEmptyLHsBinds :: LHsBindsLR idL idR -> Bool
 226 isEmptyLHsBinds = isEmptyBag
 227
 228 ------------
 229 plusHsValBinds :: HsValBinds a -> HsValBinds a -> HsValBinds a
 230 plusHsValBinds (ValBindsIn ds1 sigs1) (ValBindsIn ds2 sigs2)
 231   = ValBindsIn (ds1 `unionBags` ds2) (sigs1 ++ sigs2)
 232 plusHsValBinds (ValBindsOut ds1 sigs1) (ValBindsOut ds2 sigs2)
 233   = ValBindsOut (ds1 ++ ds2) (sigs1 ++ sigs2)
 234 \end{code}
 235
 236 What AbsBinds means
 237 ~~~~~~~~~~~~~~~~~~~
 238          AbsBinds tvs
 239                   [d1,d2]
 240                   [(tvs1, f1p, f1m),
 241                    (tvs2, f2p, f2m)]
 242                   BIND
 243 means
 244
 245         f1p = /\ tvs -> \ [d1,d2] -> letrec DBINDS and BIND
 246                                       in fm
 247
 248         gp = ...same again, with gm instead of fm
 249
 250 This is a pretty bad translation, because it duplicates all the bindings.
 251 So the desugarer tries to do a better job:
 252
 253         fp = /\ [a,b] -> \ [d1,d2] -> case tp [a,b] [d1,d2] of
 254                                         (fm,gm) -> fm
 255         ..ditto for gp..
 256
 257         tp = /\ [a,b] -> \ [d1,d2] -> letrec DBINDS and BIND
 258                                        in (fm,gm)
 259
 260 \begin{code}
 261 instance (OutputableBndr idL, OutputableBndr idR) => Outputable (HsBindLR idL idR) where
 262     ppr mbind = ppr_monobind mbind
 263
 264 ppr_monobind :: (OutputableBndr idL, OutputableBndr idR) => HsBindLR idL idR -> SDoc
 265
 266 ppr_monobind (PatBind { pat_lhs = pat, pat_rhs = grhss })      = pprPatBind pat grhss
 267 ppr_monobind (VarBind { var_id = var, var_rhs = rhs })         = pprBndr CaseBind var <+> equals <+> pprExpr (unLoc rhs)
 268 ppr_monobind (FunBind { fun_id = fun, fun_infix = inf,
 269                         fun_matches = matches,
 270                         fun_tick = tick }) =
 271                            (case tick of
 272                               Nothing -> empty
 273                               Just t  -> text "-- tick id = " <> ppr t
 274                            ) $$ pprFunBind (unLoc fun) inf matches
 275
 276 ppr_monobind (AbsBinds { abs_tvs = tyvars, abs_dicts = dictvars,
 277                          abs_exports = exports, abs_binds = val_binds })
 278      = sep [ptext (sLit "AbsBinds"),
 279             brackets (interpp'SP tyvars),
 280             brackets (interpp'SP dictvars),
 281             brackets (sep (punctuate comma (map ppr_exp exports)))]
 282        $$
 283        nest 2 ( vcat [pprBndr LetBind x | (_,x,_,_) <- exports]
 284                         -- Print type signatures
 285                 $$ pprLHsBinds val_binds )
 286   where
 287     ppr_exp (tvs, gbl, lcl, prags)
 288         = vcat [ppr gbl <+> ptext (sLit "<=") <+> ppr tvs <+> ppr lcl,
 289                 nest 2 (vcat (map (pprPrag gbl) prags))]
 290 \end{code}
 291
 292 %************************************************************************
 293 %*                                                                      *
 294                 Implicit parameter bindings
 295 %*                                                                      *
 296 %************************************************************************
 297
 298 \begin{code}
 299 data HsIPBinds id
 300   = IPBinds
 301         [LIPBind id]
 302         (DictBinds id)  -- Only in typechecker output; binds
 303                         -- uses of the implicit parameters
 304
 305 isEmptyIPBinds :: HsIPBinds id -> Bool
 306 isEmptyIPBinds (IPBinds is ds) = null is && isEmptyBag ds
 307
 308 type LIPBind id = Located (IPBind id)
 309
 310 -- | Implicit parameter bindings.
 311 data IPBind id
 312   = IPBind
 313         (IPName id)
 314         (LHsExpr id)
 315
 316 instance (OutputableBndr id) => Outputable (HsIPBinds id) where
 317   ppr (IPBinds bs ds) = pprDeeperList vcat (map ppr bs)
 318                         $$ pprLHsBinds ds
 319
 320 instance (OutputableBndr id) => Outputable (IPBind id) where
 321   ppr (IPBind id rhs) = pprBndr LetBind id <+> equals <+> pprExpr (unLoc rhs)
 322 \end{code}
 323
 324
 325 %************************************************************************
 326 %*                                                                      *
 327 \subsection{Coercion functions}
 328 %*                                                                      *
 329 %************************************************************************
 330
 331 \begin{code}
 332 -- A HsWrapper is an expression with a hole in it
 333 -- We need coercions to have concrete form so that we can zonk them
 334
 335 data HsWrapper
 336   = WpHole                      -- The identity coercion
 337
 338   | WpCompose HsWrapper HsWrapper       -- (\a1..an. []) `WpCompose` (\x1..xn. [])
 339                                 --      = (\a1..an \x1..xn. [])
 340
 341   | WpCast Coercion             -- A cast:  [] `cast` co
 342                                 -- Guaranteed not the identity coercion
 343
 344   | WpApp Var                   -- [] d         the 'd' is a type-class dictionary or coercion variable
 345
 346   | WpTyApp Type                -- [] t         the 't' is a type or corecion
 347                                 --      ToDo: it'd be tidier if 't' was always a type (not coercion),
 348                                 --            but that is inconvenient in Inst.instCallDicts
 349
 350   | WpLam Var                   -- \d. []       the 'd' is a type-class dictionary or coercion variable
 351   | WpTyLam TyVar               -- \a. []       the 'a' is a type variable (not coercion var)
 352   | WpInline                    -- inline_me []   Wrap inline around the thing
 353
 354         -- Non-empty bindings, so that the identity coercion
 355         -- is always exactly WpHole
 356   | WpLet (LHsBinds Id)         -- let binds in []
 357                                 -- (would be nicer to be core bindings)
 358
 359 instance Outputable HsWrapper where
 360   ppr co_fn = pprHsWrapper (ptext (sLit "<>")) co_fn
 361
 362 pprHsWrapper :: SDoc -> HsWrapper -> SDoc
 363 pprHsWrapper it wrap =
 364     let
 365         help it WpHole            = it
 366         help it (WpCompose f1 f2) = help (help it f2) f1
 367         help it (WpCast co)   = sep [it, nest 2 (ptext (sLit "`cast`") <+> pprParendType co)]
 368         help it (WpApp id)    = sep [it, nest 2 (ppr id)]
 369         help it (WpTyApp ty)  = sep [it, ptext (sLit "@") <+> pprParendType ty]
 370         help it (WpLam id)    = sep [ptext (sLit "\\") <> pprBndr LambdaBind id <> dot, it]
 371         help it (WpTyLam tv)  = sep [ptext (sLit "/\\") <> pprBndr LambdaBind tv <> dot, it]
 372         help it (WpLet binds) = sep [ptext (sLit "let") <+> braces (ppr binds), it]
 373         help it WpInline      = sep [ptext (sLit "_inline_me_"), it]
 374     in
 375       -- in debug mode, print the wrapper
 376       -- otherwise just print what's inside
 377       getPprStyle (\ s -> if debugStyle s then (help it wrap) else it)
 378
 379 (<.>) :: HsWrapper -> HsWrapper -> HsWrapper
 380 WpHole <.> c = c
 381 c <.> WpHole = c
 382 c1 <.> c2    = c1 `WpCompose` c2
 383
 384 mkWpTyApps :: [Type] -> HsWrapper
 385 mkWpTyApps tys = mk_co_fn WpTyApp (reverse tys)
 386
 387 mkWpApps :: [Var] -> HsWrapper
 388 mkWpApps ids = mk_co_fn WpApp (reverse ids)
 389
 390 mkWpTyLams :: [TyVar] -> HsWrapper
 391 mkWpTyLams ids = mk_co_fn WpTyLam ids
 392
 393 mkWpLams :: [Var] -> HsWrapper
 394 mkWpLams ids = mk_co_fn WpLam ids
 395
 396 mk_co_fn :: (a -> HsWrapper) -> [a] -> HsWrapper
 397 mk_co_fn f as = foldr (WpCompose . f) WpHole as
 398
 399 idHsWrapper :: HsWrapper
 400 idHsWrapper = WpHole
 401
 402 isIdHsWrapper :: HsWrapper -> Bool
 403 isIdHsWrapper WpHole = True
 404 isIdHsWrapper _      = False
 405 \end{code}
 406
 407
 408 %************************************************************************
 409 %*                                                                      *
 410 \subsection{@Sig@: type signatures and value-modifying user pragmas}
 411 %*                                                                      *
 412 %************************************************************************
 413
 414 It is convenient to lump ``value-modifying'' user-pragmas (e.g.,
 415 ``specialise this function to these four types...'') in with type
 416 signatures.  Then all the machinery to move them into place, etc.,
 417 serves for both.
 418
 419 \begin{code}
 420 type LSig name = Located (Sig name)
 421
 422 data Sig name   -- Signatures and pragmas
 423   =     -- An ordinary type signature
 424         -- f :: Num a => a -> a
 425     TypeSig     (Located name)  -- A bog-std type signature
 426                 (LHsType name)
 427
 428         -- An ordinary fixity declaration
 429         --      infixl *** 8
 430   | FixSig      (FixitySig name)        -- Fixity declaration
 431
 432         -- An inline pragma
 433         -- {#- INLINE f #-}
 434   | InlineSig   (Located name)  -- Function name
 435                 InlineSpec
 436
 437         -- A specialisation pragma
 438         -- {-# SPECIALISE f :: Int -> Int #-}
 439   | SpecSig     (Located name)  -- Specialise a function or datatype ...
 440                 (LHsType name)  -- ... to these types
 441                 InlineSpec
 442
 443         -- A specialisation pragma for instance declarations only
 444         -- {-# SPECIALISE instance Eq [Int] #-}
 445   | SpecInstSig (LHsType name)  -- (Class tys); should be a specialisation of the
 446                                 -- current instance decl
 447
 448
 449 type LFixitySig name = Located (FixitySig name)
 450 data FixitySig name = FixitySig (Located name) Fixity
 451
 452 -- A Prag conveys pragmas from the type checker to the desugarer
 453 type LPrag = Located Prag
 454 data Prag
 455   = InlinePrag
 456         InlineSpec
 457
 458   | SpecPrag
 459         (HsExpr Id)     -- An expression, of the given specialised type, which
 460         PostTcType      -- specialises the polymorphic function
 461         InlineSpec      -- Inlining spec for the specialised function
 462
 463 isInlinePrag :: Prag -> Bool
 464 isInlinePrag (InlinePrag _) = True
 465 isInlinePrag _              = False
 466
 467 isSpecPrag :: Prag -> Bool
 468 isSpecPrag (SpecPrag {}) = True
 469 isSpecPrag _             = False
 470 \end{code}
 471
 472 \begin{code}
 473 okBindSig :: Sig a -> Bool
 474 okBindSig _ = True
 475
 476 okHsBootSig :: Sig a -> Bool
 477 okHsBootSig (TypeSig  _ _) = True
 478 okHsBootSig (FixSig _)     = True
 479 okHsBootSig _              = False
 480
 481 okClsDclSig :: Sig a -> Bool
 482 okClsDclSig (SpecInstSig _) = False
 483 okClsDclSig _               = True        -- All others OK
 484
 485 okInstDclSig :: Sig a -> Bool
 486 okInstDclSig (TypeSig _ _)   = False
 487 okInstDclSig (FixSig _)      = False
 488 okInstDclSig _               = True
 489
 490 sigForThisGroup :: NameSet -> LSig Name -> Bool
 491 sigForThisGroup ns sig
 492   = case sigName sig of
 493         Nothing -> False
 494         Just n  -> n `elemNameSet` ns
 495
 496 sigName :: LSig name -> Maybe name
 497 sigName (L _ sig) = sigNameNoLoc sig
 498
 499 sigNameNoLoc :: Sig name -> Maybe name
 500 sigNameNoLoc (TypeSig   n _)          = Just (unLoc n)
 501 sigNameNoLoc (SpecSig   n _ _)        = Just (unLoc n)
 502 sigNameNoLoc (InlineSig n _)          = Just (unLoc n)
 503 sigNameNoLoc (FixSig (FixitySig n _)) = Just (unLoc n)
 504 sigNameNoLoc _                        = Nothing
 505
 506 isFixityLSig :: LSig name -> Bool
 507 isFixityLSig (L _ (FixSig {})) = True
 508 isFixityLSig _                 = False
 509
 510 isVanillaLSig :: LSig name -> Bool
 511 isVanillaLSig (L _(TypeSig {})) = True
 512 isVanillaLSig _                 = False
 513
 514 isSpecLSig :: LSig name -> Bool
 515 isSpecLSig (L _(SpecSig {})) = True
 516 isSpecLSig _                 = False
 517
 518 isSpecInstLSig :: LSig name -> Bool
 519 isSpecInstLSig (L _ (SpecInstSig {})) = True
 520 isSpecInstLSig _                      = False
 521
 522 isPragLSig :: LSig name -> Bool
 523         -- Identifies pragmas
 524 isPragLSig (L _ (SpecSig {}))   = True
 525 isPragLSig (L _ (InlineSig {})) = True
 526 isPragLSig _                    = False
 527
 528 isInlineLSig :: LSig name -> Bool
 529         -- Identifies inline pragmas
 530 isInlineLSig (L _ (InlineSig {})) = True
 531 isInlineLSig _                    = False
 532
 533 hsSigDoc :: Sig name -> SDoc
 534 hsSigDoc (TypeSig {})           = ptext (sLit "type signature")
 535 hsSigDoc (SpecSig {})           = ptext (sLit "SPECIALISE pragma")
 536 hsSigDoc (InlineSig {})         = ptext (sLit "INLINE pragma")
 537 hsSigDoc (SpecInstSig {})       = ptext (sLit "SPECIALISE instance pragma")
 538 hsSigDoc (FixSig {})            = ptext (sLit "fixity declaration")
 539 \end{code}
 540
 541 Signature equality is used when checking for duplicate signatures
 542
 543 \begin{code}
 544 eqHsSig :: Eq a => LSig a -> LSig a -> Bool
 545 eqHsSig (L _ (FixSig (FixitySig n1 _))) (L _ (FixSig (FixitySig n2 _))) = unLoc n1 == unLoc n2
 546 eqHsSig (L _ (TypeSig n1 _))            (L _ (TypeSig n2 _))            = unLoc n1 == unLoc n2
 547 eqHsSig (L _ (InlineSig n1 _))          (L _ (InlineSig n2 _))          = unLoc n1 == unLoc n2
 548         -- For specialisations, we don't have equality over
 549         -- HsType, so it's not convenient to spot duplicate
 550         -- specialisations here.  Check for this later, when we're in Type land
 551 eqHsSig _other1 _other2 = False
 552 \end{code}
 553
 554 \begin{code}
 555 instance (OutputableBndr name) => Outputable (Sig name) where
 556     ppr sig = ppr_sig sig
 557
 558 ppr_sig :: OutputableBndr name => Sig name -> SDoc
 559 ppr_sig (TypeSig var ty)          = pprVarSig (unLoc var) ty
 560 ppr_sig (FixSig fix_sig)          = ppr fix_sig
 561 ppr_sig (SpecSig var ty inl)      = pragBrackets (pprSpec var ty inl)
 562 ppr_sig (InlineSig var inl)       = pragBrackets (ppr inl <+> ppr var)
 563 ppr_sig (SpecInstSig ty)          = pragBrackets (ptext (sLit "SPECIALIZE instance") <+> ppr ty)
 564
 565 instance Outputable name => Outputable (FixitySig name) where
 566   ppr (FixitySig name fixity) = sep [ppr fixity, ppr name]
 567
 568 pragBrackets :: SDoc -> SDoc
 569 pragBrackets doc = ptext (sLit "{-#") <+> doc <+> ptext (sLit "#-}")
 570
 571 pprVarSig :: (Outputable id, Outputable ty) => id -> ty -> SDoc
 572 pprVarSig var ty = sep [ppr var <+> dcolon, nest 2 (ppr ty)]
 573
 574 pprSpec :: (Outputable id, Outputable ty) => id -> ty -> InlineSpec -> SDoc
 575 pprSpec var ty inl = sep [ptext (sLit "SPECIALIZE") <+> ppr inl <+> pprVarSig var ty]
 576
 577 pprPrag :: Outputable id => id -> LPrag -> SDoc
 578 pprPrag var (L _ (InlinePrag inl))        = ppr inl <+> ppr var
 579 pprPrag var (L _ (SpecPrag _expr ty inl)) = pprSpec var ty inl
 580 \end{code}
 581