acd4df9f5c8abd3282a5935e6ec52a641564a0f1
[ghc.git] / compiler / hsSyn / HsTypes.lhs
1 %
2 % (c) The University of Glasgow 2006
3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 %
5
6 HsTypes: Abstract syntax: user-defined types
7
8 \begin{code}
9 {-# OPTIONS -fno-warn-tabs #-}
10 -- The above warning supression flag is a temporary kludge.
11 -- While working on this module you are encouraged to remove it and
12 -- detab the module (please do the detabbing in a separate patch). See
13 --     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
14 -- for details
15
16 {-# LANGUAGE DeriveDataTypeable #-}
17
18 module HsTypes (
19         HsType(..), LHsType, HsKind, LHsKind,
20         HsTyVarBndr(..), LHsTyVarBndr,
21         HsTupleSort(..), HsExplicitFlag(..),
22         HsContext, LHsContext,
23         HsQuasiQuote(..),
24         HsTyWrapper(..),
25
26         LBangType, BangType, HsBang(..), 
27         getBangType, getBangStrictness, 
28
29         ConDeclField(..), pprConDeclFields,
30         
31         mkExplicitHsForAllTy, mkImplicitHsForAllTy, hsExplicitTvs,
32         hsTyVarName, hsTyVarNames, replaceTyVarName, replaceLTyVarName,
33         hsTyVarKind, hsLTyVarKind, hsTyVarNameKind,
34         hsLTyVarName, hsLTyVarNames, hsLTyVarLocName, hsLTyVarLocNames,
35         splitHsInstDeclTy_maybe, splitLHsInstDeclTy_maybe,
36         splitHsForAllTy, splitLHsForAllTy,
37         splitHsClassTy_maybe, splitLHsClassTy_maybe,
38         splitHsFunType,
39         splitHsAppTys, mkHsAppTys, mkHsOpTy,
40
41         -- Printing
42         pprParendHsType, pprHsForAll, pprHsContext, ppr_hs_context,
43     ) where
44
45 import {-# SOURCE #-} HsExpr ( HsSplice, pprSplice )
46
47 import HsLit
48
49 import NameSet( FreeVars )
50 import Type
51 import HsDoc
52 import BasicTypes
53 import SrcLoc
54 import StaticFlags
55 import Outputable
56 import FastString
57
58 import Data.Data
59 \end{code}
60
61
62 %************************************************************************
63 %*                                                                      *
64         Quasi quotes; used in types and elsewhere
65 %*                                                                      *
66 %************************************************************************
67
68 \begin{code}
69 data HsQuasiQuote id = HsQuasiQuote 
70                            id           -- The quasi-quoter
71                            SrcSpan      -- The span of the enclosed string
72                            FastString   -- The enclosed string
73   deriving (Data, Typeable)
74
75 instance OutputableBndr id => Outputable (HsQuasiQuote id) where
76     ppr = ppr_qq
77
78 ppr_qq :: OutputableBndr id => HsQuasiQuote id -> SDoc
79 ppr_qq (HsQuasiQuote quoter _ quote) =
80     char '[' <> ppr quoter <> ptext (sLit "|") <>
81     ppr quote <> ptext (sLit "|]")
82 \end{code}
83
84
85 %************************************************************************
86 %*                                                                      *
87 \subsection{Bang annotations}
88 %*                                                                      *
89 %************************************************************************
90
91 \begin{code}
92 type LBangType name = Located (BangType name)
93 type BangType name  = HsType name       -- Bangs are in the HsType data type
94
95 getBangType :: LHsType a -> LHsType a
96 getBangType (L _ (HsBangTy _ ty)) = ty
97 getBangType ty                    = ty
98
99 getBangStrictness :: LHsType a -> HsBang
100 getBangStrictness (L _ (HsBangTy s _)) = s
101 getBangStrictness _                    = HsNoBang
102 \end{code}
103
104
105 %************************************************************************
106 %*                                                                      *
107 \subsection{Data types}
108 %*                                                                      *
109 %************************************************************************
110
111 This is the syntax for types as seen in type signatures.
112
113 \begin{code}
114 type LHsContext name = Located (HsContext name)
115
116 type HsContext name = [LHsType name]
117
118 type LHsType name = Located (HsType name)
119 type HsKind name = HsType name
120 type LHsKind name = Located (HsKind name)
121
122 data HsType name
123   = HsForAllTy  HsExplicitFlag          -- Renamer leaves this flag unchanged, to record the way
124                                         -- the user wrote it originally, so that the printer can
125                                         -- print it as the user wrote it
126                 [LHsTyVarBndr name]     -- With ImplicitForAll, this is the empty list
127                                         -- until the renamer fills in the variables
128                 (LHsContext name)
129                 (LHsType name)
130
131   | HsTyVar             name            -- Type variable, type constructor, or data constructor
132                                         -- see Note [Promotions (HsTyVar)]
133
134   | HsAppTy             (LHsType name)
135                         (LHsType name)
136
137   | HsFunTy             (LHsType name)   -- function type
138                         (LHsType name)
139
140   | HsListTy            (LHsType name)  -- Element type
141
142   | HsPArrTy            (LHsType name)  -- Elem. type of parallel array: [:t:]
143
144   | HsTupleTy           HsTupleSort
145                         [LHsType name]  -- Element types (length gives arity)
146
147   | HsOpTy              (LHsType name) (LHsTyOp name) (LHsType name)
148
149   | HsParTy             (LHsType name)   -- See Note [Parens in HsSyn] in HsExpr
150         -- Parenthesis preserved for the precedence re-arrangement in RnTypes
151         -- It's important that a * (b + c) doesn't get rearranged to (a*b) + c!
152
153   | HsIParamTy          (IPName name)    -- (?x :: ty)
154                         (LHsType name)   -- Implicit parameters as they occur in contexts
155
156   | HsEqTy              (LHsType name)   -- ty1 ~ ty2
157                         (LHsType name)   -- Always allowed even without TypeOperators, and has special kinding rule
158
159   | HsKindSig           (LHsType name)  -- (ty :: kind)
160                         (LHsKind name)  -- A type with a kind signature
161
162   | HsQuasiQuoteTy      (HsQuasiQuote name)
163
164   | HsSpliceTy          (HsSplice name) 
165                         FreeVars        -- Variables free in the splice (filled in by renamer)
166                         PostTcKind
167
168   | HsDocTy             (LHsType name) LHsDocString -- A documented type
169
170   | HsBangTy    HsBang (LHsType name)   -- Bang-style type annotations 
171   | HsRecTy [ConDeclField name]         -- Only in data type declarations
172
173   | HsCoreTy Type       -- An escape hatch for tunnelling a *closed* 
174                         -- Core Type through HsSyn.  
175
176   | HsExplicitListTy     -- A promoted explicit list
177         PostTcKind       -- See Note [Promoted lists and tuples]
178         [LHsType name]   
179                          
180   | HsExplicitTupleTy    -- A promoted explicit tuple
181         [PostTcKind]     -- See Note [Promoted lists and tuples]
182         [LHsType name]   
183
184   | HsWrapTy HsTyWrapper (HsType name)  -- only in typechecker output
185   deriving (Data, Typeable)
186
187 data HsTyWrapper
188   = WpKiApps [Kind]  -- kind instantiation: [] k1 k2 .. kn
189   deriving (Data, Typeable)
190
191 type LHsTyOp name = HsTyOp (Located name)
192 type HsTyOp name = (HsTyWrapper, name)
193
194 mkHsOpTy :: LHsType name -> Located name -> LHsType name -> HsType name
195 mkHsOpTy ty1 op ty2 = HsOpTy ty1 (WpKiApps [], op) ty2
196 \end{code}
197
198 Note [Unit tuples]
199 ~~~~~~~~~~~~~~~~~~
200 Consider the type
201     type instance F Int = ()
202 We want to parse that "()" 
203     as HsTupleTy HsBoxedOrConstraintTuple [], 
204 NOT as HsTyVar unitTyCon
205
206 Why? Because F might have kind (* -> Constraint), so we when parsing we
207 don't know if that tuple is going to be a constraint tuple or an ordinary
208 unit tuple.  The HsTupleSort flag is specifically designed to deal with
209 that, but it has to work for unit tuples too.
210
211 Note [Promotions (HsTyVar)]
212 ~~~~~~~~~~~~~~~~~~~~~~~~~~~
213 HsTyVar: A name in a type or kind.
214   Here are the allowed namespaces for the name.
215     In a type:
216       Var: not allowed
217       Data: promoted data constructor
218       Tv: type variable
219       TcCls before renamer: type constructor, class constructor, or promoted data constructor
220       TcCls after renamer: type constructor or class constructor
221     In a kind:
222       Var, Data: not allowed
223       Tv: kind variable
224       TcCls: kind constructor or promoted type constructor
225
226
227 Note [Promoted lists and tuples]
228 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
229 Notice the difference between
230    HsListTy    HsExplicitListTy
231    HsTupleTy   HsExplicitListTupleTy
232
233 E.g.    f :: [Int]                      HsListTy                
234
235         g3  :: T '[]                   All these use  
236         g2  :: T '[True]                  HsExplicitListTy        
237         g1  :: T '[True,False]          
238         g1a :: T [True,False]             (can omit ' where unambiguous)
239
240   kind of T :: [Bool] -> *        This kind uses HsListTy!
241
242 E.g.    h :: (Int,Bool)                 HsTupleTy; f is a pair               
243         k :: S '(True,False)            HsExplicitTypleTy; S is indexed by   
244                                            a type-level pair of booleans 
245         kind of S :: (Bool,Bool) -> *   This kind uses HsExplicitTupleTy
246
247 Note [Distinguishing tuple kinds]
248 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
249
250 Apart from promotion, tuples can have one of three different kinds:
251
252         x :: (Int, Bool)                -- Regular boxed tuples
253         f :: Int# -> (# Int#, Int# #)   -- Unboxed tuples
254         g :: (Eq a, Ord a) => a         -- Constraint tuples
255
256 For convenience, internally we use a single constructor for all of these,
257 namely HsTupleTy, but keep track of the tuple kind (in the first argument to
258 HsTupleTy, a HsTupleSort). We can tell if a tuple is unboxed while parsing,
259 because of the #. However, with -XConstraintKinds we can only distinguish
260 between constraint and boxed tuples during type checking, in general. Hence the
261 four constructors of HsTupleSort:
262         
263         HsUnboxedTuple                  -> Produced by the parser
264         HsBoxedTuple                    -> Certainly a boxed tuple
265         HsConstraintTuple               -> Certainly a constraint tuple
266         HsBoxedOrConstraintTuple        -> Could be a boxed or a constraint 
267                                         tuple. Produced by the parser only,
268                                         disappears after type checking
269
270 \begin{code}
271 data HsTupleSort = HsUnboxedTuple
272                  | HsBoxedTuple
273                  | HsConstraintTuple
274                  | HsBoxedOrConstraintTuple
275                  deriving (Data, Typeable)
276
277 data HsExplicitFlag = Explicit | Implicit deriving (Data, Typeable)
278
279 data ConDeclField name  -- Record fields have Haddoc docs on them
280   = ConDeclField { cd_fld_name :: Located name,
281                    cd_fld_type :: LBangType name, 
282                    cd_fld_doc  :: Maybe LHsDocString }
283   deriving (Data, Typeable)
284
285 -----------------------
286 -- Combine adjacent for-alls. 
287 -- The following awkward situation can happen otherwise:
288 --      f :: forall a. ((Num a) => Int)
289 -- might generate HsForAll (Just [a]) [] (HsForAll Nothing [Num a] t)
290 -- Then a isn't discovered as ambiguous, and we abstract the AbsBinds wrt []
291 -- but the export list abstracts f wrt [a].  Disaster.
292 --
293 -- A valid type must have one for-all at the top of the type, or of the fn arg types
294
295 mkImplicitHsForAllTy ::                        LHsContext name -> LHsType name -> HsType name
296 mkExplicitHsForAllTy :: [LHsTyVarBndr name] -> LHsContext name -> LHsType name -> HsType name
297 mkImplicitHsForAllTy     ctxt ty = mkHsForAllTy Implicit [] ctxt ty
298 mkExplicitHsForAllTy tvs ctxt ty = mkHsForAllTy Explicit tvs ctxt ty
299
300 mkHsForAllTy :: HsExplicitFlag -> [LHsTyVarBndr name] -> LHsContext name -> LHsType name -> HsType name
301 -- Smart constructor for HsForAllTy
302 mkHsForAllTy exp tvs (L _ []) ty = mk_forall_ty exp tvs ty
303 mkHsForAllTy exp tvs ctxt ty = HsForAllTy exp tvs ctxt ty
304
305 -- mk_forall_ty makes a pure for-all type (no context)
306 mk_forall_ty :: HsExplicitFlag -> [LHsTyVarBndr name] -> LHsType name -> HsType name
307 mk_forall_ty exp  tvs  (L _ (HsParTy ty))                   = mk_forall_ty exp tvs ty
308 mk_forall_ty exp1 tvs1 (L _ (HsForAllTy exp2 tvs2 ctxt ty)) = mkHsForAllTy (exp1 `plus` exp2) (tvs1 ++ tvs2) ctxt ty
309 mk_forall_ty exp  tvs  ty                                   = HsForAllTy exp tvs (noLoc []) ty
310         -- Even if tvs is empty, we still make a HsForAll!
311         -- In the Implicit case, this signals the place to do implicit quantification
312         -- In the Explicit case, it prevents implicit quantification    
313         --      (see the sigtype production in Parser.y.pp)
314         --      so that (forall. ty) isn't implicitly quantified
315
316 plus :: HsExplicitFlag -> HsExplicitFlag -> HsExplicitFlag
317 Implicit `plus` Implicit = Implicit
318 _        `plus` _        = Explicit
319
320 hsExplicitTvs :: LHsType name -> [name]
321 -- The explicitly-given forall'd type variables of a HsType
322 hsExplicitTvs (L _ (HsForAllTy Explicit tvs _ _)) = hsLTyVarNames tvs
323 hsExplicitTvs _                                   = []
324
325 ---------------------
326 type LHsTyVarBndr name = Located (HsTyVarBndr name)
327
328 data HsTyVarBndr name
329   = UserTyVar           -- No explicit kinding
330          name           -- See Note [Printing KindedTyVars]
331          PostTcKind
332
333   | KindedTyVar
334          name
335          (LHsKind name) -- The user-supplied kind signature
336          PostTcKind
337       --  *** NOTA BENE *** A "monotype" in a pragma can have
338       -- for-alls in it, (mostly to do with dictionaries).  These
339       -- must be explicitly Kinded.
340   deriving (Data, Typeable)
341
342 hsTyVarName :: HsTyVarBndr name -> name
343 hsTyVarName (UserTyVar n _)   = n
344 hsTyVarName (KindedTyVar n _ _) = n
345
346 hsTyVarKind :: HsTyVarBndr name -> Kind
347 hsTyVarKind (UserTyVar _ k)   = k
348 hsTyVarKind (KindedTyVar _ _ k) = k
349
350 hsLTyVarKind :: LHsTyVarBndr name -> Kind
351 hsLTyVarKind  = hsTyVarKind . unLoc
352
353 hsTyVarNameKind :: HsTyVarBndr name -> (name, Kind)
354 hsTyVarNameKind (UserTyVar n k)   = (n,k)
355 hsTyVarNameKind (KindedTyVar n _ k) = (n,k)
356
357 hsLTyVarName :: LHsTyVarBndr name -> name
358 hsLTyVarName = hsTyVarName . unLoc
359
360 hsTyVarNames :: [HsTyVarBndr name] -> [name]
361 hsTyVarNames tvs = map hsTyVarName tvs
362
363 hsLTyVarNames :: [LHsTyVarBndr name] -> [name]
364 hsLTyVarNames = map hsLTyVarName
365
366 hsLTyVarLocName :: LHsTyVarBndr name -> Located name
367 hsLTyVarLocName = fmap hsTyVarName
368
369 hsLTyVarLocNames :: [LHsTyVarBndr name] -> [Located name]
370 hsLTyVarLocNames = map hsLTyVarLocName
371
372 replaceTyVarName :: (Monad m) => HsTyVarBndr name1 -> name2  -- new type name
373                     -> (LHsKind name1 -> m (LHsKind name2))  -- kind renaming
374                     -> m (HsTyVarBndr name2)
375 replaceTyVarName (UserTyVar _ k) n' _ = return $ UserTyVar n' k
376 replaceTyVarName (KindedTyVar _ k tck) n' rn = do
377   k' <- rn k
378   return $ KindedTyVar n' k' tck
379
380 replaceLTyVarName :: (Monad m) => LHsTyVarBndr name1 -> name2
381                   -> (LHsKind name1 -> m (LHsKind name2))
382                   -> m (LHsTyVarBndr name2)
383 replaceLTyVarName (L loc n1) n2 rn = replaceTyVarName n1 n2 rn >>= return . L loc
384 \end{code}
385
386
387 \begin{code}
388 splitHsAppTys :: LHsType n -> [LHsType n] -> (LHsType n, [LHsType n])
389 splitHsAppTys (L _ (HsAppTy f a)) as = splitHsAppTys f (a:as)
390 splitHsAppTys f                   as = (f,as)
391
392 mkHsAppTys :: OutputableBndr n => LHsType n -> [LHsType n] -> HsType n
393 mkHsAppTys fun_ty [] = pprPanic "mkHsAppTys" (ppr fun_ty)
394 mkHsAppTys fun_ty (arg_ty:arg_tys)
395   = foldl mk_app (HsAppTy fun_ty arg_ty) arg_tys
396   where
397     mk_app fun arg = HsAppTy (noLoc fun) arg    
398        -- Add noLocs for inner nodes of the application; 
399        -- they are never used 
400
401 splitHsInstDeclTy_maybe :: HsType name 
402                         -> Maybe ([LHsTyVarBndr name], HsContext name, name, [LHsType name])
403 splitHsInstDeclTy_maybe ty
404   = fmap (\(tvs, cxt, L _ n, tys) -> (tvs, cxt, n, tys)) $ splitLHsInstDeclTy_maybe (noLoc ty)
405
406 splitLHsInstDeclTy_maybe
407     :: LHsType name 
408     -> Maybe ([LHsTyVarBndr name], HsContext name, Located name, [LHsType name])
409         -- Split up an instance decl type, returning the pieces
410 splitLHsInstDeclTy_maybe inst_ty = do
411     let (tvs, cxt, ty) = splitLHsForAllTy inst_ty
412     (cls, tys) <- splitLHsClassTy_maybe ty
413     return (tvs, cxt, cls, tys)
414
415 splitHsForAllTy :: HsType name -> ([LHsTyVarBndr name], HsContext name, HsType name)
416 splitHsForAllTy ty = case splitLHsForAllTy (noLoc ty) of (tvs, cxt, L _ ty) -> (tvs, cxt, ty)
417
418 splitLHsForAllTy
419     :: LHsType name 
420     -> ([LHsTyVarBndr name], HsContext name, LHsType name)
421 splitLHsForAllTy poly_ty
422   = case unLoc poly_ty of
423         HsParTy ty              -> splitLHsForAllTy ty
424         HsForAllTy _ tvs cxt ty -> (tvs, unLoc cxt, ty)
425         _                       -> ([], [], poly_ty)
426         -- The type vars should have been computed by now, even if they were implicit
427
428 splitHsClassTy_maybe :: HsType name -> Maybe (name, [LHsType name])
429 splitHsClassTy_maybe ty = fmap (\(L _ n, tys) -> (n, tys)) $ splitLHsClassTy_maybe (noLoc ty)
430
431 splitLHsClassTy_maybe :: LHsType name -> Maybe (Located name, [LHsType name])
432 --- Watch out.. in ...deriving( Show )... we use this on 
433 --- the list of partially applied predicates in the deriving,
434 --- so there can be zero args.
435
436 -- In TcDeriv we also use this to figure out what data type is being
437 -- mentioned in a deriving (Generic (Foo bar baz)) declaration (i.e. "Foo").
438 splitLHsClassTy_maybe ty
439   = checkl ty []
440   where
441     checkl (L l ty) args = case ty of
442         HsTyVar t          -> Just (L l t, args)
443         HsAppTy l r        -> checkl l (r:args)
444         HsOpTy l (_, tc) r -> checkl (fmap HsTyVar tc) (l:r:args)
445         HsParTy t          -> checkl t args
446         HsKindSig ty _     -> checkl ty args
447         _                  -> Nothing
448
449 -- Splits HsType into the (init, last) parts
450 -- Breaks up any parens in the result type: 
451 --      splitHsFunType (a -> (b -> c)) = ([a,b], c)
452 splitHsFunType :: LHsType name -> ([LHsType name], LHsType name)
453 splitHsFunType (L _ (HsFunTy x y)) = (x:args, res)
454   where
455   (args, res) = splitHsFunType y
456 splitHsFunType (L _ (HsParTy ty))  = splitHsFunType ty
457 splitHsFunType other               = ([], other)
458 \end{code}
459
460
461 %************************************************************************
462 %*                                                                      *
463 \subsection{Pretty printing}
464 %*                                                                      *
465 %************************************************************************
466
467 \begin{code}
468 instance (OutputableBndr name) => Outputable (HsType name) where
469     ppr ty = pprHsType ty
470
471 instance (OutputableBndr name) => Outputable (HsTyVarBndr name) where
472     ppr (UserTyVar name _)      = ppr name
473     ppr (KindedTyVar name kind _) = parens $ hsep [ppr name, dcolon, ppr kind]
474
475 pprHsForAll :: OutputableBndr name => HsExplicitFlag -> [LHsTyVarBndr name] ->  LHsContext name -> SDoc
476 pprHsForAll exp tvs cxt 
477   | show_forall = forall_part <+> pprHsContext (unLoc cxt)
478   | otherwise   = pprHsContext (unLoc cxt)
479   where
480     show_forall =  opt_PprStyle_Debug
481                 || (not (null tvs) && is_explicit)
482     is_explicit = case exp of {Explicit -> True; Implicit -> False}
483     forall_part = ptext (sLit "forall") <+> interppSP tvs <> dot
484
485 pprHsContext :: (OutputableBndr name) => HsContext name -> SDoc
486 pprHsContext []         = empty
487 pprHsContext [L _ pred] = ppr pred <+> darrow
488 pprHsContext cxt        = ppr_hs_context cxt <+> darrow
489
490 ppr_hs_context :: (OutputableBndr name) => HsContext name -> SDoc
491 ppr_hs_context []  = empty
492 ppr_hs_context cxt = parens (interpp'SP cxt)
493
494 pprConDeclFields :: OutputableBndr name => [ConDeclField name] -> SDoc
495 pprConDeclFields fields = braces (sep (punctuate comma (map ppr_fld fields)))
496   where
497     ppr_fld (ConDeclField { cd_fld_name = n, cd_fld_type = ty, 
498                             cd_fld_doc = doc })
499         = ppr n <+> dcolon <+> ppr ty <+> ppr_mbDoc doc
500 \end{code}
501
502 Note [Printing KindedTyVars]
503 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
504 Trac #3830 reminded me that we should really only print the kind
505 signature on a KindedTyVar if the kind signature was put there by the
506 programmer.  During kind inference GHC now adds a PostTcKind to UserTyVars,
507 rather than converting to KindedTyVars as before.
508
509 (As it happens, the message in #3830 comes out a different way now,
510 and the problem doesn't show up; but having the flag on a KindedTyVar
511 seems like the Right Thing anyway.)
512
513 \begin{code}
514 pREC_TOP, pREC_FUN, pREC_OP, pREC_CON :: Int
515 pREC_TOP = 0  -- type   in ParseIface.y
516 pREC_FUN = 1  -- btype  in ParseIface.y
517               -- Used for LH arg of (->)
518 pREC_OP  = 2  -- Used for arg of any infix operator
519               -- (we don't keep their fixities around)
520 pREC_CON = 3  -- Used for arg of type applicn:
521               -- always parenthesise unless atomic
522
523 maybeParen :: Int       -- Precedence of context
524            -> Int       -- Precedence of top-level operator
525            -> SDoc -> SDoc      -- Wrap in parens if (ctxt >= op)
526 maybeParen ctxt_prec op_prec p | ctxt_prec >= op_prec = parens p
527                                | otherwise            = p
528         
529 -- printing works more-or-less as for Types
530
531 pprHsType, pprParendHsType :: (OutputableBndr name) => HsType name -> SDoc
532
533 pprHsType ty       = getPprStyle $ \sty -> ppr_mono_ty pREC_TOP (prepare sty ty)
534 pprParendHsType ty = ppr_mono_ty pREC_CON ty
535
536 -- Before printing a type
537 -- (a) Remove outermost HsParTy parens
538 -- (b) Drop top-level for-all type variables in user style
539 --     since they are implicit in Haskell
540 prepare :: PprStyle -> HsType name -> HsType name
541 prepare sty (HsParTy ty)          = prepare sty (unLoc ty)
542 prepare _   ty                    = ty
543
544 ppr_mono_lty :: (OutputableBndr name) => Int -> LHsType name -> SDoc
545 ppr_mono_lty ctxt_prec ty = ppr_mono_ty ctxt_prec (unLoc ty)
546
547 ppr_mono_ty :: (OutputableBndr name) => Int -> HsType name -> SDoc
548 ppr_mono_ty ctxt_prec (HsForAllTy exp tvs ctxt ty)
549   = maybeParen ctxt_prec pREC_FUN $
550     sep [pprHsForAll exp tvs ctxt, ppr_mono_lty pREC_TOP ty]
551
552 ppr_mono_ty _    (HsBangTy b ty)     = ppr b <> ppr ty
553 ppr_mono_ty _    (HsQuasiQuoteTy qq) = ppr qq
554 ppr_mono_ty _    (HsRecTy flds)      = pprConDeclFields flds
555 ppr_mono_ty _    (HsTyVar name)      = ppr name
556 ppr_mono_ty prec (HsFunTy ty1 ty2)   = ppr_fun_ty prec ty1 ty2
557 ppr_mono_ty _    (HsTupleTy con tys) = tupleParens std_con (interpp'SP tys)
558   where std_con = case con of
559                     HsUnboxedTuple -> UnboxedTuple
560                     _              -> BoxedTuple
561 ppr_mono_ty _    (HsKindSig ty kind) = parens (ppr_mono_lty pREC_TOP ty <+> dcolon <+> ppr kind)
562 ppr_mono_ty _    (HsListTy ty)       = brackets (ppr_mono_lty pREC_TOP ty)
563 ppr_mono_ty _    (HsPArrTy ty)       = paBrackets (ppr_mono_lty pREC_TOP ty)
564 ppr_mono_ty prec (HsIParamTy n ty)   = maybeParen prec pREC_FUN (ppr n <+> dcolon <+> ppr_mono_lty pREC_TOP ty)
565 ppr_mono_ty _    (HsSpliceTy s _ _)  = pprSplice s
566 ppr_mono_ty _    (HsCoreTy ty)       = ppr ty
567 ppr_mono_ty _    (HsExplicitListTy _ tys) = quote $ brackets (interpp'SP tys)
568 ppr_mono_ty _    (HsExplicitTupleTy _ tys) = quote $ parens (interpp'SP tys)
569
570 ppr_mono_ty ctxt_prec (HsWrapTy (WpKiApps _kis) ty)
571   = ppr_mono_ty ctxt_prec ty
572 -- We are not printing kind applications. If we wanted to do so, we should do
573 -- something like this:
574 {-
575   = go ctxt_prec kis ty
576   where
577     go ctxt_prec [] ty = ppr_mono_ty ctxt_prec ty
578     go ctxt_prec (ki:kis) ty
579       = maybeParen ctxt_prec pREC_CON $
580         hsep [ go pREC_FUN kis ty
581              , ptext (sLit "@") <> pprParendKind ki ]
582 -}
583
584 ppr_mono_ty ctxt_prec (HsEqTy ty1 ty2)
585   = maybeParen ctxt_prec pREC_OP $
586     ppr_mono_lty pREC_OP ty1 <+> char '~' <+> ppr_mono_lty pREC_OP ty2
587
588 ppr_mono_ty ctxt_prec (HsAppTy fun_ty arg_ty)
589   = maybeParen ctxt_prec pREC_CON $
590     hsep [ppr_mono_lty pREC_FUN fun_ty, ppr_mono_lty pREC_CON arg_ty]
591
592 ppr_mono_ty ctxt_prec (HsOpTy ty1 (wrapper, op) ty2)
593   = maybeParen ctxt_prec pREC_OP $
594     ppr_mono_lty pREC_OP ty1 <+> ppr_mono_ty pREC_CON (HsWrapTy wrapper (HsTyVar (unLoc op))) <+> ppr_mono_lty pREC_OP ty2
595
596 ppr_mono_ty _         (HsParTy ty)
597   = parens (ppr_mono_lty pREC_TOP ty)
598   -- Put the parens in where the user did
599   -- But we still use the precedence stuff to add parens because
600   --    toHsType doesn't put in any HsParTys, so we may still need them
601
602 ppr_mono_ty ctxt_prec (HsDocTy ty doc) 
603   = maybeParen ctxt_prec pREC_OP $
604     ppr_mono_lty pREC_OP ty <+> ppr (unLoc doc)
605   -- we pretty print Haddock comments on types as if they were
606   -- postfix operators
607
608 --------------------------
609 ppr_fun_ty :: (OutputableBndr name) => Int -> LHsType name -> LHsType name -> SDoc
610 ppr_fun_ty ctxt_prec ty1 ty2
611   = let p1 = ppr_mono_lty pREC_FUN ty1
612         p2 = ppr_mono_lty pREC_TOP ty2
613     in
614     maybeParen ctxt_prec pREC_FUN $
615     sep [p1, ptext (sLit "->") <+> p2]
616 \end{code}
617
618