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],
 136        -- AbsBinds only gets used when idL = idR after renaming,
 137        -- but these need to be idL's for the collect... code in HsUtil to have
 138        -- the right type
 139         abs_exports :: [([TyVar], idL, idL, [LPrag])],  -- (tvs, poly_id, mono_id, prags)
 140         abs_binds   :: LHsBinds idL             -- The dictionary bindings and typechecked user bindings
 141                                                 -- mixed up together; you can tell the dict bindings because
 142                                                 -- they are all VarBinds
 143     }
 144         -- Consider (AbsBinds tvs ds [(ftvs, poly_f, mono_f) binds]
 145         --
 146         -- Creates bindings for (polymorphic, overloaded) poly_f
 147         -- in terms of monomorphic, non-overloaded mono_f
 148         --
 149         -- Invariants:
 150         --      1. 'binds' binds mono_f
 151         --      2. ftvs is a subset of tvs
 152         --      3. ftvs includes all tyvars free in ds
 153         --
 154         -- See section 9 of static semantics paper for more details.
 155         -- (You can get a PhD for explaining the True Meaning
 156         --  of this last construct.)
 157
 158 placeHolderNames :: NameSet
 159 -- Used for the NameSet in FunBind and PatBind prior to the renamer
 160 placeHolderNames = panic "placeHolderNames"
 161
 162 ------------
 163 instance (OutputableBndr idL, OutputableBndr idR) => Outputable (HsLocalBindsLR idL idR) where
 164   ppr (HsValBinds bs) = ppr bs
 165   ppr (HsIPBinds bs)  = ppr bs
 166   ppr EmptyLocalBinds = empty
 167
 168 instance (OutputableBndr idL, OutputableBndr idR) => Outputable (HsValBindsLR idL idR) where
 169   ppr (ValBindsIn binds sigs)
 170    = pprValBindsForUser binds sigs
 171
 172   ppr (ValBindsOut sccs sigs)
 173     = getPprStyle $ \ sty ->
 174       if debugStyle sty then    -- Print with sccs showing
 175         vcat (map ppr sigs) $$ vcat (map ppr_scc sccs)
 176      else
 177         pprValBindsForUser (unionManyBags (map snd sccs)) sigs
 178    where
 179      ppr_scc (rec_flag, binds) = pp_rec rec_flag <+> pprLHsBinds binds
 180      pp_rec Recursive    = ptext (sLit "rec")
 181      pp_rec NonRecursive = ptext (sLit "nonrec")
 182
 183 --  *not* pprLHsBinds because we don't want braces; 'let' and
 184 -- 'where' include a list of HsBindGroups and we don't want
 185 -- several groups of bindings each with braces around.
 186 -- Sort by location before printing
 187 pprValBindsForUser :: (OutputableBndr idL, OutputableBndr idR, OutputableBndr id2)
 188                    => LHsBindsLR idL idR -> [LSig id2] -> SDoc
 189 pprValBindsForUser binds sigs
 190   = pprDeeperList vcat (map snd (sort_by_loc decls))
 191   where
 192
 193     decls :: [(SrcSpan, SDoc)]
 194     decls = [(loc, ppr sig)  | L loc sig <- sigs] ++
 195              [(loc, ppr bind) | L loc bind <- bagToList binds]
 196
 197     sort_by_loc decls = sortLe (\(l1,_) (l2,_) -> l1 <= l2) decls
 198
 199 pprLHsBinds :: (OutputableBndr idL, OutputableBndr idR) => LHsBindsLR idL idR -> SDoc
 200 pprLHsBinds binds
 201   | isEmptyLHsBinds binds = empty
 202   | otherwise = lbrace <+> pprDeeperList vcat (map ppr (bagToList binds)) <+> rbrace
 203
 204 ------------
 205 emptyLocalBinds :: HsLocalBindsLR a b
 206 emptyLocalBinds = EmptyLocalBinds
 207
 208 isEmptyLocalBinds :: HsLocalBindsLR a b -> Bool
 209 isEmptyLocalBinds (HsValBinds ds) = isEmptyValBinds ds
 210 isEmptyLocalBinds (HsIPBinds ds)  = isEmptyIPBinds ds
 211 isEmptyLocalBinds EmptyLocalBinds = True
 212
 213 isEmptyValBinds :: HsValBindsLR a b -> Bool
 214 isEmptyValBinds (ValBindsIn ds sigs)  = isEmptyLHsBinds ds && null sigs
 215 isEmptyValBinds (ValBindsOut ds sigs) = null ds && null sigs
 216
 217 emptyValBindsIn, emptyValBindsOut :: HsValBindsLR a b
 218 emptyValBindsIn  = ValBindsIn emptyBag []
 219 emptyValBindsOut = ValBindsOut []      []
 220
 221 emptyLHsBinds :: LHsBindsLR idL idR
 222 emptyLHsBinds = emptyBag
 223
 224 isEmptyLHsBinds :: LHsBindsLR idL idR -> Bool
 225 isEmptyLHsBinds = isEmptyBag
 226
 227 ------------
 228 plusHsValBinds :: HsValBinds a -> HsValBinds a -> HsValBinds a
 229 plusHsValBinds (ValBindsIn ds1 sigs1) (ValBindsIn ds2 sigs2)
 230   = ValBindsIn (ds1 `unionBags` ds2) (sigs1 ++ sigs2)
 231 plusHsValBinds (ValBindsOut ds1 sigs1) (ValBindsOut ds2 sigs2)
 232   = ValBindsOut (ds1 ++ ds2) (sigs1 ++ sigs2)
 233 \end{code}
 234
 235 What AbsBinds means
 236 ~~~~~~~~~~~~~~~~~~~
 237          AbsBinds tvs
 238                   [d1,d2]
 239                   [(tvs1, f1p, f1m),
 240                    (tvs2, f2p, f2m)]
 241                   BIND
 242 means
 243
 244         f1p = /\ tvs -> \ [d1,d2] -> letrec DBINDS and BIND
 245                                       in fm
 246
 247         gp = ...same again, with gm instead of fm
 248
 249 This is a pretty bad translation, because it duplicates all the bindings.
 250 So the desugarer tries to do a better job:
 251
 252         fp = /\ [a,b] -> \ [d1,d2] -> case tp [a,b] [d1,d2] of
 253                                         (fm,gm) -> fm
 254         ..ditto for gp..
 255
 256         tp = /\ [a,b] -> \ [d1,d2] -> letrec DBINDS and BIND
 257                                        in (fm,gm)
 258
 259 \begin{code}
 260 instance (OutputableBndr idL, OutputableBndr idR) => Outputable (HsBindLR idL idR) where
 261     ppr mbind = ppr_monobind mbind
 262
 263 ppr_monobind :: (OutputableBndr idL, OutputableBndr idR) => HsBindLR idL idR -> SDoc
 264
 265 ppr_monobind (PatBind { pat_lhs = pat, pat_rhs = grhss })      = pprPatBind pat grhss
 266 ppr_monobind (VarBind { var_id = var, var_rhs = rhs })         = pprBndr CaseBind var <+> equals <+> pprExpr (unLoc rhs)
 267 ppr_monobind (FunBind { fun_id = fun, fun_infix = inf,
 268                         fun_matches = matches,
 269                         fun_tick = tick }) =
 270                            (case tick of
 271                               Nothing -> empty
 272                               Just t  -> text "-- tick id = " <> ppr t
 273                            ) $$ pprFunBind (unLoc fun) inf matches
 274
 275 ppr_monobind (AbsBinds { abs_tvs = tyvars, abs_dicts = dictvars,
 276                          abs_exports = exports, abs_binds = val_binds })
 277      = sep [ptext (sLit "AbsBinds"),
 278             brackets (interpp'SP tyvars),
 279             brackets (interpp'SP dictvars),
 280             brackets (sep (punctuate comma (map ppr_exp exports)))]
 281        $$
 282        nest 2 ( vcat [pprBndr LetBind x | (_,x,_,_) <- exports]
 283                         -- Print type signatures
 284                 $$ pprLHsBinds val_binds )
 285   where
 286     ppr_exp (tvs, gbl, lcl, prags)
 287         = vcat [ppr gbl <+> ptext (sLit "<=") <+> ppr tvs <+> ppr lcl,
 288                 nest 2 (vcat (map (pprPrag gbl) prags))]
 289 \end{code}
 290
 291 %************************************************************************
 292 %*                                                                      *
 293                 Implicit parameter bindings
 294 %*                                                                      *
 295 %************************************************************************
 296
 297 \begin{code}
 298 data HsIPBinds id
 299   = IPBinds
 300         [LIPBind id]
 301         (DictBinds id)  -- Only in typechecker output; binds
 302                         -- uses of the implicit parameters
 303
 304 isEmptyIPBinds :: HsIPBinds id -> Bool
 305 isEmptyIPBinds (IPBinds is ds) = null is && isEmptyBag ds
 306
 307 type LIPBind id = Located (IPBind id)
 308
 309 -- | Implicit parameter bindings.
 310 data IPBind id
 311   = IPBind
 312         (IPName id)
 313         (LHsExpr id)
 314
 315 instance (OutputableBndr id) => Outputable (HsIPBinds id) where
 316   ppr (IPBinds bs ds) = pprDeeperList vcat (map ppr bs)
 317                         $$ pprLHsBinds ds
 318
 319 instance (OutputableBndr id) => Outputable (IPBind id) where
 320   ppr (IPBind id rhs) = pprBndr LetBind id <+> equals <+> pprExpr (unLoc rhs)
 321 \end{code}
 322
 323
 324 %************************************************************************
 325 %*                                                                      *
 326 \subsection{Coercion functions}
 327 %*                                                                      *
 328 %************************************************************************
 329
 330 \begin{code}
 331 -- A HsWrapper is an expression with a hole in it
 332 -- We need coercions to have concrete form so that we can zonk them
 333
 334 data HsWrapper
 335   = WpHole                      -- The identity coercion
 336
 337   | WpCompose HsWrapper HsWrapper       -- (\a1..an. []) `WpCompose` (\x1..xn. [])
 338                                 --      = (\a1..an \x1..xn. [])
 339
 340   | WpCast Coercion             -- A cast:  [] `cast` co
 341                                 -- Guaranteed not the identity coercion
 342
 343   | WpApp Var                   -- [] d         the 'd' is a type-class dictionary or coercion variable
 344
 345   | WpTyApp Type                -- [] t         the 't' is a type or corecion
 346                                 --      ToDo: it'd be tidier if 't' was always a type (not coercion),
 347                                 --            but that is inconvenient in Inst.instCallDicts
 348
 349   | WpLam Var                   -- \d. []       the 'd' is a type-class dictionary or coercion variable
 350   | WpTyLam TyVar               -- \a. []       the 'a' is a type variable (not coercion var)
 351   | WpInline                    -- inline_me []   Wrap inline around the thing
 352
 353         -- Non-empty bindings, so that the identity coercion
 354         -- is always exactly WpHole
 355   | WpLet (LHsBinds Id)         -- let binds in []
 356                                 -- (would be nicer to be core bindings)
 357
 358 instance Outputable HsWrapper where
 359   ppr co_fn = pprHsWrapper (ptext (sLit "<>")) co_fn
 360
 361 pprHsWrapper :: SDoc -> HsWrapper -> SDoc
 362 pprHsWrapper it wrap =
 363     let
 364         help it WpHole            = it
 365         help it (WpCompose f1 f2) = help (help it f2) f1
 366         help it (WpCast co)   = sep [it, nest 2 (ptext (sLit "`cast`") <+> pprParendType co)]
 367         help it (WpApp id)    = sep [it, nest 2 (ppr id)]
 368         help it (WpTyApp ty)  = sep [it, ptext (sLit "@") <+> pprParendType ty]
 369         help it (WpLam id)    = sep [ptext (sLit "\\") <> pprBndr LambdaBind id <> dot, it]
 370         help it (WpTyLam tv)  = sep [ptext (sLit "/\\") <> pprBndr LambdaBind tv <> dot, it]
 371         help it (WpLet binds) = sep [ptext (sLit "let") <+> braces (ppr binds), it]
 372         help it WpInline      = sep [ptext (sLit "_inline_me_"), it]
 373     in
 374       -- in debug mode, print the wrapper
 375       -- otherwise just print what's inside
 376       getPprStyle (\ s -> if debugStyle s then (help it wrap) else it)
 377
 378 (<.>) :: HsWrapper -> HsWrapper -> HsWrapper
 379 WpHole <.> c = c
 380 c <.> WpHole = c
 381 c1 <.> c2    = c1 `WpCompose` c2
 382
 383 mkWpTyApps :: [Type] -> HsWrapper
 384 mkWpTyApps tys = mk_co_fn WpTyApp (reverse tys)
 385
 386 mkWpApps :: [Id] -> HsWrapper
 387 mkWpApps ids = mk_co_fn WpApp (reverse ids)
 388
 389 mkWpTyLams :: [TyVar] -> HsWrapper
 390 mkWpTyLams ids = mk_co_fn WpTyLam ids
 391
 392 mkWpLams :: [Id] -> HsWrapper
 393 mkWpLams ids = mk_co_fn WpLam ids
 394
 395 mk_co_fn :: (a -> HsWrapper) -> [a] -> HsWrapper
 396 mk_co_fn f as = foldr (WpCompose . f) WpHole as
 397
 398 idHsWrapper :: HsWrapper
 399 idHsWrapper = WpHole
 400
 401 isIdHsWrapper :: HsWrapper -> Bool
 402 isIdHsWrapper WpHole = True
 403 isIdHsWrapper _      = False
 404 \end{code}
 405
 406
 407 %************************************************************************
 408 %*                                                                      *
 409 \subsection{@Sig@: type signatures and value-modifying user pragmas}
 410 %*                                                                      *
 411 %************************************************************************
 412
 413 It is convenient to lump ``value-modifying'' user-pragmas (e.g.,
 414 ``specialise this function to these four types...'') in with type
 415 signatures.  Then all the machinery to move them into place, etc.,
 416 serves for both.
 417
 418 \begin{code}
 419 type LSig name = Located (Sig name)
 420
 421 data Sig name   -- Signatures and pragmas
 422   =     -- An ordinary type signature
 423         -- f :: Num a => a -> a
 424     TypeSig     (Located name)  -- A bog-std type signature
 425                 (LHsType name)
 426
 427         -- An ordinary fixity declaration
 428         --      infixl *** 8
 429   | FixSig      (FixitySig name)        -- Fixity declaration
 430
 431         -- An inline pragma
 432         -- {#- INLINE f #-}
 433   | InlineSig   (Located name)  -- Function name
 434                 InlineSpec
 435
 436         -- A specialisation pragma
 437         -- {-# SPECIALISE f :: Int -> Int #-}
 438   | SpecSig     (Located name)  -- Specialise a function or datatype ...
 439                 (LHsType name)  -- ... to these types
 440                 InlineSpec
 441
 442         -- A specialisation pragma for instance declarations only
 443         -- {-# SPECIALISE instance Eq [Int] #-}
 444   | SpecInstSig (LHsType name)  -- (Class tys); should be a specialisation of the
 445                                 -- current instance decl
 446
 447
 448 type LFixitySig name = Located (FixitySig name)
 449 data FixitySig name = FixitySig (Located name) Fixity
 450
 451 -- A Prag conveys pragmas from the type checker to the desugarer
 452 type LPrag = Located Prag
 453 data Prag
 454   = InlinePrag
 455         InlineSpec
 456
 457   | SpecPrag
 458         (HsExpr Id)     -- An expression, of the given specialised type, which
 459         PostTcType      -- specialises the polymorphic function
 460         InlineSpec      -- Inlining spec for the specialised function
 461
 462 isInlinePrag :: Prag -> Bool
 463 isInlinePrag (InlinePrag _) = True
 464 isInlinePrag _              = False
 465
 466 isSpecPrag :: Prag -> Bool
 467 isSpecPrag (SpecPrag {}) = True
 468 isSpecPrag _             = False
 469 \end{code}
 470
 471 \begin{code}
 472 okBindSig :: Sig a -> Bool
 473 okBindSig _ = True
 474
 475 okHsBootSig :: Sig a -> Bool
 476 okHsBootSig (TypeSig  _ _) = True
 477 okHsBootSig (FixSig _)     = True
 478 okHsBootSig _              = False
 479
 480 okClsDclSig :: Sig a -> Bool
 481 okClsDclSig (SpecInstSig _) = False
 482 okClsDclSig _               = True        -- All others OK
 483
 484 okInstDclSig :: Sig a -> Bool
 485 okInstDclSig (TypeSig _ _)   = False
 486 okInstDclSig (FixSig _)      = False
 487 okInstDclSig _               = True
 488
 489 sigForThisGroup :: NameSet -> LSig Name -> Bool
 490 sigForThisGroup ns sig
 491   = case sigName sig of
 492         Nothing -> False
 493         Just n  -> n `elemNameSet` ns
 494
 495 sigName :: LSig name -> Maybe name
 496 sigName (L _ sig) = sigNameNoLoc sig
 497
 498 sigNameNoLoc :: Sig name -> Maybe name
 499 sigNameNoLoc (TypeSig   n _)          = Just (unLoc n)
 500 sigNameNoLoc (SpecSig   n _ _)        = Just (unLoc n)
 501 sigNameNoLoc (InlineSig n _)          = Just (unLoc n)
 502 sigNameNoLoc (FixSig (FixitySig n _)) = Just (unLoc n)
 503 sigNameNoLoc _                        = Nothing
 504
 505 isFixityLSig :: LSig name -> Bool
 506 isFixityLSig (L _ (FixSig {})) = True
 507 isFixityLSig _                 = False
 508
 509 isVanillaLSig :: LSig name -> Bool
 510 isVanillaLSig (L _(TypeSig {})) = True
 511 isVanillaLSig _                 = False
 512
 513 isSpecLSig :: LSig name -> Bool
 514 isSpecLSig (L _(SpecSig {})) = True
 515 isSpecLSig _                 = False
 516
 517 isSpecInstLSig :: LSig name -> Bool
 518 isSpecInstLSig (L _ (SpecInstSig {})) = True
 519 isSpecInstLSig _                      = False
 520
 521 isPragLSig :: LSig name -> Bool
 522         -- Identifies pragmas
 523 isPragLSig (L _ (SpecSig {}))   = True
 524 isPragLSig (L _ (InlineSig {})) = True
 525 isPragLSig _                    = False
 526
 527 isInlineLSig :: LSig name -> Bool
 528         -- Identifies inline pragmas
 529 isInlineLSig (L _ (InlineSig {})) = True
 530 isInlineLSig _                    = False
 531
 532 hsSigDoc :: Sig name -> SDoc
 533 hsSigDoc (TypeSig {})           = ptext (sLit "type signature")
 534 hsSigDoc (SpecSig {})           = ptext (sLit "SPECIALISE pragma")
 535 hsSigDoc (InlineSig {})         = ptext (sLit "INLINE pragma")
 536 hsSigDoc (SpecInstSig {})       = ptext (sLit "SPECIALISE instance pragma")
 537 hsSigDoc (FixSig {})            = ptext (sLit "fixity declaration")
 538 \end{code}
 539
 540 Signature equality is used when checking for duplicate signatures
 541
 542 \begin{code}
 543 eqHsSig :: Eq a => LSig a -> LSig a -> Bool
 544 eqHsSig (L _ (FixSig (FixitySig n1 _))) (L _ (FixSig (FixitySig n2 _))) = unLoc n1 == unLoc n2
 545 eqHsSig (L _ (TypeSig n1 _))            (L _ (TypeSig n2 _))            = unLoc n1 == unLoc n2
 546 eqHsSig (L _ (InlineSig n1 _))          (L _ (InlineSig n2 _))          = unLoc n1 == unLoc n2
 547         -- For specialisations, we don't have equality over
 548         -- HsType, so it's not convenient to spot duplicate
 549         -- specialisations here.  Check for this later, when we're in Type land
 550 eqHsSig _other1 _other2 = False
 551 \end{code}
 552
 553 \begin{code}
 554 instance (OutputableBndr name) => Outputable (Sig name) where
 555     ppr sig = ppr_sig sig
 556
 557 ppr_sig :: OutputableBndr name => Sig name -> SDoc
 558 ppr_sig (TypeSig var ty)          = pprVarSig (unLoc var) ty
 559 ppr_sig (FixSig fix_sig)          = ppr fix_sig
 560 ppr_sig (SpecSig var ty inl)      = pragBrackets (pprSpec var ty inl)
 561 ppr_sig (InlineSig var inl)       = pragBrackets (ppr inl <+> ppr var)
 562 ppr_sig (SpecInstSig ty)          = pragBrackets (ptext (sLit "SPECIALIZE instance") <+> ppr ty)
 563
 564 instance Outputable name => Outputable (FixitySig name) where
 565   ppr (FixitySig name fixity) = sep [ppr fixity, ppr name]
 566
 567 pragBrackets :: SDoc -> SDoc
 568 pragBrackets doc = ptext (sLit "{-#") <+> doc <+> ptext (sLit "#-}")
 569
 570 pprVarSig :: (Outputable id, Outputable ty) => id -> ty -> SDoc
 571 pprVarSig var ty = sep [ppr var <+> dcolon, nest 2 (ppr ty)]
 572
 573 pprSpec :: (Outputable id, Outputable ty) => id -> ty -> InlineSpec -> SDoc
 574 pprSpec var ty inl = sep [ptext (sLit "SPECIALIZE") <+> ppr inl <+> pprVarSig var ty]
 575
 576 pprPrag :: Outputable id => id -> LPrag -> SDoc
 577 pprPrag var (L _ (InlinePrag inl))        = ppr inl <+> ppr var
 578 pprPrag var (L _ (SpecPrag _expr ty inl)) = pprSpec var ty inl
 579 \end{code}
 580