2 % (c) The University of Glasgow 2006
3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
6 HsTypes: Abstract syntax: user-defined types
10 -- The above warning supression flag is a temporary kludge.
11 -- While working on this module you are encouraged to remove it and fix
12 -- any warnings in the module. See
13 -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
18 HsTyVarBndr(..), LHsTyVarBndr,
20 HsContext, LHsContext,
23 LBangType, BangType, HsBang(..),
24 getBangType, getBangStrictness,
26 mkExplicitHsForAllTy, mkImplicitHsForAllTy, hsExplicitTvs,
27 hsTyVarName, hsTyVarNames, replaceTyVarName,
28 hsLTyVarName, hsLTyVarNames, hsLTyVarLocName, hsLTyVarLocNames,
29 splitHsInstDeclTy, splitHsFunType,
32 PostTcType, placeHolderType,
35 pprParendHsType, pprHsForAll, pprHsContext, ppr_hs_context, pprHsTyVarBndr
38 #include "HsVersions.h"
40 import {-# SOURCE #-} HsExpr ( HsSplice, pprSplice )
51 %************************************************************************
53 \subsection{Annotating the syntax}
55 %************************************************************************
58 type PostTcType = Type -- Used for slots in the abstract syntax
59 -- where we want to keep slot for a type
60 -- to be added by the type checker...but
61 -- before typechecking it's just bogus
63 placeHolderType :: PostTcType -- Used before typechecking
64 placeHolderType = panic "Evaluated the place holder for a PostTcType"
67 %************************************************************************
69 \subsection{Bang annotations}
71 %************************************************************************
74 type LBangType name = Located (BangType name)
75 type BangType name = HsType name -- Bangs are in the HsType data type
77 data HsBang = HsNoBang -- Only used as a return value for getBangStrictness,
78 -- never appears on a HsBangTy
80 | HsUnbox -- {-# UNPACK #-} ! (GHC extension, meaning "unbox")
82 instance Outputable HsBang where
83 ppr (HsNoBang) = empty
84 ppr (HsStrict) = char '!'
85 ppr (HsUnbox) = ptext SLIT("!!")
87 getBangType :: LHsType a -> LHsType a
88 getBangType (L _ (HsBangTy _ ty)) = ty
91 getBangStrictness :: LHsType a -> HsBang
92 getBangStrictness (L _ (HsBangTy s _)) = s
93 getBangStrictness _ = HsNoBang
97 %************************************************************************
99 \subsection{Data types}
101 %************************************************************************
103 This is the syntax for types as seen in type signatures.
106 type LHsContext name = Located (HsContext name)
108 type HsContext name = [LHsPred name]
110 type LHsPred name = Located (HsPred name)
112 data HsPred name = HsClassP name [LHsType name] -- class constraint
113 | HsEqualP (LHsType name) (LHsType name)-- equality constraint
114 | HsIParam (IPName name) (LHsType name)
116 type LHsType name = Located (HsType name)
119 = HsForAllTy HsExplicitForAll -- Renamer leaves this flag unchanged, to record the way
120 -- the user wrote it originally, so that the printer can
121 -- print it as the user wrote it
122 [LHsTyVarBndr name] -- With ImplicitForAll, this is the empty list
123 -- until the renamer fills in the variables
127 | HsTyVar name -- Type variable or type constructor
129 | HsBangTy HsBang (LHsType name) -- Bang-style type annotations
131 | HsAppTy (LHsType name)
134 | HsFunTy (LHsType name) -- function type
137 | HsListTy (LHsType name) -- Element type
139 | HsPArrTy (LHsType name) -- Elem. type of parallel array: [:t:]
142 [LHsType name] -- Element types (length gives arity)
144 | HsOpTy (LHsType name) (Located name) (LHsType name)
146 | HsParTy (LHsType name)
147 -- Parenthesis preserved for the precedence re-arrangement in RnTypes
148 -- It's important that a * (b + c) doesn't get rearranged to (a*b) + c!
150 -- However, NB that toHsType doesn't add HsParTys (in an effort to keep
151 -- interface files smaller), so when printing a HsType we may need to
154 | HsNumTy Integer -- Generics only
156 | HsPredTy (HsPred name) -- Only used in the type of an instance
157 -- declaration, eg. Eq [a] -> Eq a
160 -- Note no need for location info on the
161 -- enclosed HsPred; the one on the type will do
163 | HsKindSig (LHsType name) -- (ty :: kind)
164 Kind -- A type with a kind signature
166 | HsSpliceTy (HsSplice name)
168 | HsDocTy (LHsType name) (LHsDoc name) -- A documented type
170 data HsExplicitForAll = Explicit | Implicit
172 -----------------------
173 -- Combine adjacent for-alls.
174 -- The following awkward situation can happen otherwise:
175 -- f :: forall a. ((Num a) => Int)
176 -- might generate HsForAll (Just [a]) [] (HsForAll Nothing [Num a] t)
177 -- Then a isn't discovered as ambiguous, and we abstract the AbsBinds wrt []
178 -- but the export list abstracts f wrt [a]. Disaster.
180 -- A valid type must have one for-all at the top of the type, or of the fn arg types
182 mkImplicitHsForAllTy ctxt ty = mkHsForAllTy Implicit [] ctxt ty
183 mkExplicitHsForAllTy tvs ctxt ty = mkHsForAllTy Explicit tvs ctxt ty
185 mkHsForAllTy :: HsExplicitForAll -> [LHsTyVarBndr name] -> LHsContext name -> LHsType name -> HsType name
186 -- Smart constructor for HsForAllTy
187 mkHsForAllTy exp tvs (L _ []) ty = mk_forall_ty exp tvs ty
188 mkHsForAllTy exp tvs ctxt ty = HsForAllTy exp tvs ctxt ty
190 -- mk_forall_ty makes a pure for-all type (no context)
191 mk_forall_ty exp tvs (L _ (HsParTy ty)) = mk_forall_ty exp tvs ty
192 mk_forall_ty exp1 tvs1 (L _ (HsForAllTy exp2 tvs2 ctxt ty)) = mkHsForAllTy (exp1 `plus` exp2) (tvs1 ++ tvs2) ctxt ty
193 mk_forall_ty exp tvs ty = HsForAllTy exp tvs (L noSrcSpan []) ty
194 -- Even if tvs is empty, we still make a HsForAll!
195 -- In the Implicit case, this signals the place to do implicit quantification
196 -- In the Explicit case, it prevents implicit quantification
197 -- (see the sigtype production in Parser.y.pp)
198 -- so that (forall. ty) isn't implicitly quantified
200 Implicit `plus` Implicit = Implicit
201 exp1 `plus` exp2 = Explicit
203 hsExplicitTvs :: LHsType name -> [name]
204 -- The explicitly-given forall'd type variables of a HsType
205 hsExplicitTvs (L _ (HsForAllTy Explicit tvs _ _)) = hsLTyVarNames tvs
206 hsExplicitTvs other = []
208 ---------------------
209 type LHsTyVarBndr name = Located (HsTyVarBndr name)
211 data HsTyVarBndr name
213 | KindedTyVar name Kind
214 -- *** NOTA BENE *** A "monotype" in a pragma can have
215 -- for-alls in it, (mostly to do with dictionaries). These
216 -- must be explicitly Kinded.
218 hsTyVarName :: HsTyVarBndr name -> name
219 hsTyVarName (UserTyVar n) = n
220 hsTyVarName (KindedTyVar n _) = n
222 hsLTyVarName :: LHsTyVarBndr name -> name
223 hsLTyVarName = hsTyVarName . unLoc
225 hsTyVarNames :: [HsTyVarBndr name] -> [name]
226 hsTyVarNames tvs = map hsTyVarName tvs
228 hsLTyVarNames :: [LHsTyVarBndr name] -> [name]
229 hsLTyVarNames = map hsLTyVarName
231 hsLTyVarLocName :: LHsTyVarBndr name -> Located name
232 hsLTyVarLocName = fmap hsTyVarName
234 hsLTyVarLocNames :: [LHsTyVarBndr name] -> [Located name]
235 hsLTyVarLocNames = map hsLTyVarLocName
237 replaceTyVarName :: HsTyVarBndr name1 -> name2 -> HsTyVarBndr name2
238 replaceTyVarName (UserTyVar n) n' = UserTyVar n'
239 replaceTyVarName (KindedTyVar n k) n' = KindedTyVar n' k
245 :: OutputableBndr name
247 -> ([LHsTyVarBndr name], HsContext name, name, [LHsType name])
248 -- Split up an instance decl type, returning the pieces
250 splitHsInstDeclTy inst_ty
252 HsParTy (L _ ty) -> splitHsInstDeclTy ty
253 HsForAllTy _ tvs cxt (L _ ty) -> split_tau tvs (unLoc cxt) ty
254 other -> split_tau [] [] other
255 -- The type vars should have been computed by now, even if they were implicit
257 split_tau tvs cxt (HsPredTy (HsClassP cls tys)) = (tvs, cxt, cls, tys)
258 split_tau tvs cxt (HsParTy (L _ ty)) = split_tau tvs cxt ty
259 split_tau _ _ other = pprPanic "splitHsInstDeclTy" (ppr inst_ty)
261 -- Splits HsType into the (init, last) parts
262 -- Breaks up any parens in the result type:
263 -- splitHsFunType (a -> (b -> c)) = ([a,b], c)
264 splitHsFunType :: LHsType name -> ([LHsType name], LHsType name)
265 splitHsFunType (L l (HsFunTy x y)) = (x:args, res)
267 (args, res) = splitHsFunType y
268 splitHsFunType (L _ (HsParTy ty)) = splitHsFunType ty
269 splitHsFunType other = ([], other)
273 %************************************************************************
275 \subsection{Pretty printing}
277 %************************************************************************
280 instance (OutputableBndr name) => Outputable (HsType name) where
281 ppr ty = pprHsType ty
283 instance (Outputable name) => Outputable (HsTyVarBndr name) where
284 ppr (UserTyVar name) = ppr name
285 ppr (KindedTyVar name kind) = pprHsTyVarBndr name kind
287 instance OutputableBndr name => Outputable (HsPred name) where
288 ppr (HsClassP clas tys) = ppr clas <+> hsep (map pprLHsType tys)
289 ppr (HsEqualP t1 t2) = hsep [pprLHsType t1, ptext SLIT("~"),
291 ppr (HsIParam n ty) = hsep [ppr n, dcolon, ppr ty]
293 pprLHsType :: OutputableBndr name => LHsType name -> SDoc
294 pprLHsType = pprParendHsType . unLoc
296 pprHsTyVarBndr :: Outputable name => name -> Kind -> SDoc
297 pprHsTyVarBndr name kind | isLiftedTypeKind kind = ppr name
298 | otherwise = hsep [ppr name, dcolon, pprParendKind kind]
300 pprHsForAll exp tvs cxt
301 | show_forall = forall_part <+> pprHsContext (unLoc cxt)
302 | otherwise = pprHsContext (unLoc cxt)
304 show_forall = opt_PprStyle_Debug
305 || (not (null tvs) && is_explicit)
306 is_explicit = case exp of {Explicit -> True; Implicit -> False}
307 forall_part = ptext SLIT("forall") <+> interppSP tvs <> dot
309 pprHsContext :: (OutputableBndr name) => HsContext name -> SDoc
310 pprHsContext [] = empty
311 pprHsContext cxt = ppr_hs_context cxt <+> ptext SLIT("=>")
313 ppr_hs_context [] = empty
314 ppr_hs_context cxt = parens (interpp'SP cxt)
318 pREC_TOP = (0 :: Int) -- type in ParseIface.y
319 pREC_FUN = (1 :: Int) -- btype in ParseIface.y
320 -- Used for LH arg of (->)
321 pREC_OP = (2 :: Int) -- Used for arg of any infix operator
322 -- (we don't keep their fixities around)
323 pREC_CON = (3 :: Int) -- Used for arg of type applicn:
324 -- always parenthesise unless atomic
326 maybeParen :: Int -- Precedence of context
327 -> Int -- Precedence of top-level operator
328 -> SDoc -> SDoc -- Wrap in parens if (ctxt >= op)
329 maybeParen ctxt_prec op_prec p | ctxt_prec >= op_prec = parens p
332 -- printing works more-or-less as for Types
334 pprHsType, pprParendHsType :: (OutputableBndr name) => HsType name -> SDoc
336 pprHsType ty = getPprStyle $ \sty -> ppr_mono_ty pREC_TOP (prepare sty ty)
337 pprParendHsType ty = ppr_mono_ty pREC_CON ty
339 -- Before printing a type
340 -- (a) Remove outermost HsParTy parens
341 -- (b) Drop top-level for-all type variables in user style
342 -- since they are implicit in Haskell
343 prepare sty (HsParTy ty) = prepare sty (unLoc ty)
346 ppr_mono_lty ctxt_prec ty = ppr_mono_ty ctxt_prec (unLoc ty)
348 ppr_mono_ty ctxt_prec (HsForAllTy exp tvs ctxt ty)
349 = maybeParen ctxt_prec pREC_FUN $
350 sep [pprHsForAll exp tvs ctxt, ppr_mono_lty pREC_TOP ty]
352 ppr_mono_ty ctxt_prec (HsBangTy b ty) = ppr b <> ppr ty
353 ppr_mono_ty ctxt_prec (HsTyVar name) = ppr name
354 ppr_mono_ty ctxt_prec (HsFunTy ty1 ty2) = ppr_fun_ty ctxt_prec ty1 ty2
355 ppr_mono_ty ctxt_prec (HsTupleTy con tys) = tupleParens con (interpp'SP tys)
356 ppr_mono_ty ctxt_prec (HsKindSig ty kind) = parens (ppr_mono_lty pREC_TOP ty <+> dcolon <+> pprKind kind)
357 ppr_mono_ty ctxt_prec (HsListTy ty) = brackets (ppr_mono_lty pREC_TOP ty)
358 ppr_mono_ty ctxt_prec (HsPArrTy ty) = pabrackets (ppr_mono_lty pREC_TOP ty)
359 ppr_mono_ty ctxt_prec (HsPredTy pred) = ppr pred
360 ppr_mono_ty ctxt_prec (HsNumTy n) = integer n -- generics only
361 ppr_mono_ty ctxt_prec (HsSpliceTy s) = pprSplice s
363 ppr_mono_ty ctxt_prec (HsAppTy fun_ty arg_ty)
364 = maybeParen ctxt_prec pREC_CON $
365 hsep [ppr_mono_lty pREC_FUN fun_ty, ppr_mono_lty pREC_CON arg_ty]
367 ppr_mono_ty ctxt_prec (HsOpTy ty1 op ty2)
368 = maybeParen ctxt_prec pREC_OP $
369 ppr_mono_lty pREC_OP ty1 <+> ppr op <+> ppr_mono_lty pREC_OP ty2
371 ppr_mono_ty ctxt_prec (HsParTy ty)
372 = parens (ppr_mono_lty pREC_TOP ty)
373 -- Put the parens in where the user did
374 -- But we still use the precedence stuff to add parens because
375 -- toHsType doesn't put in any HsParTys, so we may still need them
377 ppr_mono_ty ctxt_prec (HsDocTy ty doc)
378 = ppr ty <+> ppr (unLoc doc)
380 --------------------------
381 ppr_fun_ty ctxt_prec ty1 ty2
382 = let p1 = ppr_mono_lty pREC_FUN ty1
383 p2 = ppr_mono_lty pREC_TOP ty2
385 maybeParen ctxt_prec pREC_FUN $
386 sep [p1, ptext SLIT("->") <+> p2]
388 --------------------------
389 pabrackets p = ptext SLIT("[:") <> p <> ptext SLIT(":]")