give a more useful message when the static flags have not been initialised (#1938)
[ghc-hetmet.git] / 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 -w #-}
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 #include "HsVersions.h"
20
21 import {-# SOURCE #-} HsExpr ( HsExpr, pprExpr, LHsExpr,
22                                MatchGroup, pprFunBind,
23                                GRHSs, pprPatBind )
24 import {-# SOURCE #-} HsPat  ( LPat )
25
26 import HsTypes
27 import PprCore ()
28 import Coercion
29 import Type
30 import Name
31 import NameSet
32 import BasicTypes
33 import Outputable       
34 import SrcLoc
35 import Util
36 import Var
37 import Bag
38 \end{code}
39
40 %************************************************************************
41 %*                                                                      *
42 \subsection{Bindings: @BindGroup@}
43 %*                                                                      *
44 %************************************************************************
45
46 Global bindings (where clauses)
47
48 \begin{code}
49 -- During renaming, we need bindings where the left-hand sides
50 -- have been renamed but the the right-hand sides have not.
51 -- the ...LR datatypes are parametrized by two id types,
52 -- one for the left and one for the right.
53 -- Other than during renaming, these will be the same.
54
55 type HsLocalBinds id = HsLocalBindsLR id id
56
57 data HsLocalBindsLR idL idR     -- Bindings in a 'let' expression
58                                -- or a 'where' clause
59   = HsValBinds (HsValBindsLR idL idR)
60   | HsIPBinds  (HsIPBinds idR)
61   | EmptyLocalBinds
62
63 type HsValBinds id = HsValBindsLR id id
64
65 data HsValBindsLR idL idR  -- Value bindings (not implicit parameters)
66   = ValBindsIn             -- Before typechecking
67         (LHsBindsLR idL idR) [LSig idR] -- Not dependency analysed
68                                         -- Recursive by default
69
70   | ValBindsOut                -- After renaming
71         [(RecFlag, LHsBinds idL)]       -- Dependency analysed, later bindings 
72                                         -- in the list may depend on earlier
73                                         -- ones.
74         [LSig Name]
75
76 type LHsBinds id  = Bag (LHsBind id)
77 type DictBinds id = LHsBinds id         -- Used for dictionary or method bindings
78 type LHsBind  id  = Located (HsBind id)
79 type HsBind id = HsBindLR id id
80
81 type LHsBindLR idL idR = Located (HsBindLR idL idR)
82 type LHsBindsLR idL idR = Bag (LHsBindLR idL idR)
83
84 data HsBindLR idL idR
85   = FunBind {   -- FunBind is used for both functions   f x = e
86                 -- and variables                        f = \x -> e
87 -- Reason 1: Special case for type inference: see TcBinds.tcMonoBinds
88 --
89 -- Reason 2: instance decls can only have FunBinds, which is convenient
90 --           If you change this, you'll need tochange e.g. rnMethodBinds
91
92 -- But note that the form       f :: a->a = ...
93 -- parses as a pattern binding, just like
94 --                      (f :: a -> a) = ... 
95
96         fun_id :: Located idL,
97
98         fun_infix :: Bool,      -- True => infix declaration
99
100         fun_matches :: MatchGroup idR,  -- The payload
101
102         fun_co_fn :: HsWrapper, -- Coercion from the type of the MatchGroup to the type of
103                                 -- the Id.  Example:
104                                 --      f :: Int -> forall a. a -> a
105                                 --      f x y = y
106                                 -- Then the MatchGroup will have type (Int -> a' -> a')
107                                 -- (with a free type variable a').  The coercion will take
108                                 -- a CoreExpr of this type and convert it to a CoreExpr of
109                                 -- type         Int -> forall a'. a' -> a'
110                                 -- Notice that the coercion captures the free a'.
111
112         bind_fvs :: NameSet,    -- After the renamer, this contains a superset of the 
113                                 -- Names of the other binders in this binding group that 
114                                 -- are free in the RHS of the defn
115                                 -- Before renaming, and after typechecking, 
116                                 -- the field is unused; it's just an error thunk
117
118         fun_tick :: Maybe (Int,[idR])   -- This is the (optional) module-local tick number. 
119     }
120
121   | PatBind {   -- The pattern is never a simple variable;
122                 -- That case is done by FunBind
123         pat_lhs    :: LPat idL,
124         pat_rhs    :: GRHSs idR,
125         pat_rhs_ty :: PostTcType,       -- Type of the GRHSs
126         bind_fvs   :: NameSet           -- Same as for FunBind
127     }
128
129   | VarBind {   -- Dictionary binding and suchlike 
130         var_id :: idL,          -- All VarBinds are introduced by the type checker
131         var_rhs :: LHsExpr idR  -- Located only for consistency
132     }
133
134   | AbsBinds {                                  -- Binds abstraction; TRANSLATION
135        abs_tvs     :: [TyVar],  
136         abs_dicts   :: [DictId],
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 })         = ppr 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   | WpCo Coercion               -- A cast:  [] `cast` co
342                                 -- Guaranteedn not the identity coercion
343
344   | WpApp Var                   -- [] d         the 'd' is a type-class dictionary
345   | WpTyApp Type                -- [] t         the 't' is a type or corecion
346   | WpLam Id                    -- \d. []       the 'd' is a type-class dictionary
347   | WpTyLam TyVar               -- \a. []       the 'a' is a type or coercion variable
348   | WpInline                    -- inline_me []   Wrap inline around the thing
349
350         -- Non-empty bindings, so that the identity coercion
351         -- is always exactly WpHole
352   | WpLet (LHsBinds Id)         -- let binds in []
353                                 -- (would be nicer to be core bindings)
354
355 instance Outputable HsWrapper where 
356   ppr co_fn = pprHsWrapper (ptext SLIT("<>")) co_fn
357
358 pprHsWrapper :: SDoc -> HsWrapper -> SDoc
359 pprHsWrapper it wrap = 
360     let 
361         help it WpHole            = it
362         help it (WpCompose f1 f2) = help (help it f2) f1
363         help it (WpCo co)     = sep [it, nest 2 (ptext SLIT("`cast`") <+> pprParendType co)]
364         help it (WpApp id)    = sep [it, nest 2 (ppr id)]
365         help it (WpTyApp ty)  = sep [it, ptext SLIT("@") <+> pprParendType ty]
366         help it (WpLam id)    = sep [ptext SLIT("\\") <> pprBndr LambdaBind id <> dot, it]
367         help it (WpTyLam tv)  = sep [ptext SLIT("/\\") <> pprBndr LambdaBind tv <> dot, it]
368         help it (WpLet binds) = sep [ptext SLIT("let") <+> braces (ppr binds), it]
369         help it WpInline      = sep [ptext SLIT("_inline_me_"), it]
370     in
371       -- in debug mode, print the wrapper
372       -- otherwise just print what's inside
373       getPprStyle (\ s -> if debugStyle s then (help it wrap) else it)
374
375 (<.>) :: HsWrapper -> HsWrapper -> HsWrapper
376 WpHole <.> c = c
377 c <.> WpHole = c
378 c1 <.> c2    = c1 `WpCompose` c2
379
380 mkWpTyApps :: [Type] -> HsWrapper
381 mkWpTyApps tys = mk_co_fn WpTyApp (reverse tys)
382
383 mkWpApps :: [Id] -> HsWrapper
384 mkWpApps ids = mk_co_fn WpApp (reverse ids)
385
386 mkWpTyLams :: [TyVar] -> HsWrapper
387 mkWpTyLams ids = mk_co_fn WpTyLam ids
388
389 mkWpLams :: [Id] -> HsWrapper
390 mkWpLams ids = mk_co_fn WpLam ids
391
392 mk_co_fn :: (a -> HsWrapper) -> [a] -> HsWrapper
393 mk_co_fn f as = foldr (WpCompose . f) WpHole as
394
395 idHsWrapper :: HsWrapper
396 idHsWrapper = WpHole
397
398 isIdHsWrapper :: HsWrapper -> Bool
399 isIdHsWrapper WpHole = True
400 isIdHsWrapper other  = False
401 \end{code}
402
403
404 %************************************************************************
405 %*                                                                      *
406 \subsection{@Sig@: type signatures and value-modifying user pragmas}
407 %*                                                                      *
408 %************************************************************************
409
410 It is convenient to lump ``value-modifying'' user-pragmas (e.g.,
411 ``specialise this function to these four types...'') in with type
412 signatures.  Then all the machinery to move them into place, etc.,
413 serves for both.
414
415 \begin{code}
416 type LSig name = Located (Sig name)
417
418 data Sig name   -- Signatures and pragmas
419   =     -- An ordinary type signature
420         -- f :: Num a => a -> a
421     TypeSig     (Located name)  -- A bog-std type signature
422                 (LHsType name)
423
424         -- An ordinary fixity declaration
425         --      infixl *** 8
426   | FixSig      (FixitySig name)        -- Fixity declaration
427
428         -- An inline pragma
429         -- {#- INLINE f #-}
430   | InlineSig   (Located name)  -- Function name
431                 InlineSpec
432
433         -- A specialisation pragma
434         -- {-# SPECIALISE f :: Int -> Int #-}
435   | SpecSig     (Located name)  -- Specialise a function or datatype ...
436                 (LHsType name)  -- ... to these types
437                 InlineSpec
438
439         -- A specialisation pragma for instance declarations only
440         -- {-# SPECIALISE instance Eq [Int] #-}
441   | SpecInstSig (LHsType name)  -- (Class tys); should be a specialisation of the 
442                                 -- current instance decl
443
444
445 type LFixitySig name = Located (FixitySig name)
446 data FixitySig name = FixitySig (Located name) Fixity 
447
448 -- A Prag conveys pragmas from the type checker to the desugarer
449 type LPrag = Located Prag
450 data Prag 
451   = InlinePrag 
452         InlineSpec
453
454   | SpecPrag   
455         (HsExpr Id)     -- An expression, of the given specialised type, which
456         PostTcType      -- specialises the polymorphic function
457         [Id]            -- Dicts mentioned free in the expression
458                         --   Apr07: I think this is pretty useless
459                         --          see Note [Const rule dicts] in DsBinds
460         InlineSpec      -- Inlining spec for the specialised function
461
462 isInlinePrag (InlinePrag _) = True
463 isInlinePrag prag           = False
464
465 isSpecPrag (SpecPrag {}) = True
466 isSpecPrag prag          = False
467 \end{code}
468
469 \begin{code}
470 okBindSig :: NameSet -> LSig Name -> Bool
471 okBindSig ns sig = sigForThisGroup ns sig
472
473 okHsBootSig :: LSig Name -> Bool
474 okHsBootSig (L _ (TypeSig  _ _)) = True
475 okHsBootSig (L _ (FixSig _))     = True
476 okHsBootSig sig                  = False
477
478 okClsDclSig :: LSig Name -> Bool
479 okClsDclSig (L _ (SpecInstSig _)) = False
480 okClsDclSig sig                   = True        -- All others OK
481
482 okInstDclSig :: NameSet -> LSig Name -> Bool
483 okInstDclSig ns lsig@(L _ sig) = ok ns sig
484   where
485     ok ns (TypeSig _ _)   = False
486     ok ns (FixSig _)      = False
487     ok ns (SpecInstSig _) = True
488     ok ns sig             = sigForThisGroup ns lsig
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 other                              = 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 sig               = False
513
514 isSpecLSig :: LSig name -> Bool
515 isSpecLSig (L _(SpecSig {})) = True
516 isSpecLSig sig               = False
517
518 isSpecInstLSig (L _ (SpecInstSig {})) = True
519 isSpecInstLSig sig                    = False
520
521 isPragLSig :: LSig name -> Bool
522         -- Identifies pragmas 
523 isPragLSig (L _ (SpecSig {}))   = True
524 isPragLSig (L _ (InlineSig {})) = True
525 isPragLSig other                = False
526
527 isInlineLSig :: LSig name -> Bool
528         -- Identifies inline pragmas 
529 isInlineLSig (L _ (InlineSig {})) = True
530 isInlineLSig other                = False
531
532 hsSigDoc (TypeSig {})           = ptext SLIT("type signature")
533 hsSigDoc (SpecSig {})           = ptext SLIT("SPECIALISE pragma")
534 hsSigDoc (InlineSig _ spec)     = ptext SLIT("INLINE pragma")
535 hsSigDoc (SpecInstSig {})       = ptext SLIT("SPECIALISE instance pragma")
536 hsSigDoc (FixSig {})            = ptext SLIT("fixity declaration")
537 \end{code}
538
539 Signature equality is used when checking for duplicate signatures
540
541 \begin{code}
542 eqHsSig :: LSig Name -> LSig Name -> Bool
543 eqHsSig (L _ (FixSig (FixitySig n1 _))) (L _ (FixSig (FixitySig n2 _))) = unLoc n1 == unLoc n2
544 eqHsSig (L _ (TypeSig n1 _))            (L _ (TypeSig n2 _))            = unLoc n1 == unLoc n2
545 eqHsSig (L _ (InlineSig n1 s1)) (L _ (InlineSig n2 s2))                 = unLoc n1 == unLoc n2
546         -- For specialisations, we don't have equality over
547         -- HsType, so it's not convenient to spot duplicate 
548         -- specialisations here.  Check for this later, when we're in Type land
549 eqHsSig _other1 _other2 = False
550 \end{code}
551
552 \begin{code}
553 instance (OutputableBndr name) => Outputable (Sig name) where
554     ppr sig = ppr_sig sig
555
556 ppr_sig :: OutputableBndr name => Sig name -> SDoc
557 ppr_sig (TypeSig var ty)          = pprVarSig (unLoc var) ty
558 ppr_sig (FixSig fix_sig)          = ppr fix_sig
559 ppr_sig (SpecSig var ty inl)      = pragBrackets (pprSpec var ty inl)
560 ppr_sig (InlineSig var inl)       = pragBrackets (ppr inl <+> ppr var)
561 ppr_sig (SpecInstSig ty)          = pragBrackets (ptext SLIT("SPECIALIZE instance") <+> ppr ty)
562
563 instance Outputable name => Outputable (FixitySig name) where
564   ppr (FixitySig name fixity) = sep [ppr fixity, ppr name]
565
566 pragBrackets :: SDoc -> SDoc
567 pragBrackets doc = ptext SLIT("{-#") <+> doc <+> ptext SLIT("#-}") 
568
569 pprVarSig :: (Outputable id, Outputable ty) => id -> ty -> SDoc
570 pprVarSig var ty = sep [ppr var <+> dcolon, nest 2 (ppr ty)]
571
572 pprSpec :: (Outputable id, Outputable ty) => id -> ty -> InlineSpec -> SDoc
573 pprSpec var ty inl = sep [ptext SLIT("SPECIALIZE") <+> ppr inl <+> pprVarSig var ty]
574
575 pprPrag :: Outputable id => id -> LPrag -> SDoc
576 pprPrag var (L _ (InlinePrag inl))         = ppr inl <+> ppr var
577 pprPrag var (L _ (SpecPrag expr ty _ inl)) = pprSpec var ty inl
578 \end{code}
579