2 % (c) The University of Glasgow 2006
3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
6 HsTypes: Abstract syntax: user-defined types
11 HsTyVarBndr(..), LHsTyVarBndr,
13 HsContext, LHsContext,
16 LBangType, BangType, HsBang(..),
17 getBangType, getBangStrictness,
19 ConDeclField(..), pprConDeclFields,
21 mkExplicitHsForAllTy, mkImplicitHsForAllTy, hsExplicitTvs,
22 hsTyVarName, hsTyVarNames, replaceTyVarName,
23 hsLTyVarName, hsLTyVarNames, hsLTyVarLocName, hsLTyVarLocNames,
24 splitHsInstDeclTy, splitHsFunType,
27 PostTcType, placeHolderType,
30 pprParendHsType, pprHsForAll, pprHsContext, ppr_hs_context, pprHsTyVarBndr
33 import {-# SOURCE #-} HsExpr ( HsSplice, pprSplice )
45 %************************************************************************
47 \subsection{Annotating the syntax}
49 %************************************************************************
52 type PostTcType = Type -- Used for slots in the abstract syntax
53 -- where we want to keep slot for a type
54 -- to be added by the type checker...but
55 -- before typechecking it's just bogus
57 placeHolderType :: PostTcType -- Used before typechecking
58 placeHolderType = panic "Evaluated the place holder for a PostTcType"
61 %************************************************************************
63 \subsection{Bang annotations}
65 %************************************************************************
68 type LBangType name = Located (BangType name)
69 type BangType name = HsType name -- Bangs are in the HsType data type
71 data HsBang = HsNoBang -- Only used as a return value for getBangStrictness,
72 -- never appears on a HsBangTy
74 | HsUnbox -- {-# UNPACK #-} ! (GHC extension, meaning "unbox")
76 instance Outputable HsBang where
77 ppr (HsNoBang) = empty
78 ppr (HsStrict) = char '!'
79 ppr (HsUnbox) = ptext (sLit "!!")
81 getBangType :: LHsType a -> LHsType a
82 getBangType (L _ (HsBangTy _ ty)) = ty
85 getBangStrictness :: LHsType a -> HsBang
86 getBangStrictness (L _ (HsBangTy s _)) = s
87 getBangStrictness _ = HsNoBang
91 %************************************************************************
93 \subsection{Data types}
95 %************************************************************************
97 This is the syntax for types as seen in type signatures.
100 type LHsContext name = Located (HsContext name)
102 type HsContext name = [LHsPred name]
104 type LHsPred name = Located (HsPred name)
106 data HsPred name = HsClassP name [LHsType name] -- class constraint
107 | HsEqualP (LHsType name) (LHsType name)-- equality constraint
108 | HsIParam (IPName name) (LHsType name)
110 type LHsType name = Located (HsType name)
113 = HsForAllTy HsExplicitForAll -- Renamer leaves this flag unchanged, to record the way
114 -- the user wrote it originally, so that the printer can
115 -- print it as the user wrote it
116 [LHsTyVarBndr name] -- With ImplicitForAll, this is the empty list
117 -- until the renamer fills in the variables
121 | HsTyVar name -- Type variable or type constructor
123 | HsAppTy (LHsType name)
126 | HsFunTy (LHsType name) -- function type
129 | HsListTy (LHsType name) -- Element type
131 | HsPArrTy (LHsType name) -- Elem. type of parallel array: [:t:]
134 [LHsType name] -- Element types (length gives arity)
136 | HsOpTy (LHsType name) (Located name) (LHsType name)
138 | HsParTy (LHsType name)
139 -- Parenthesis preserved for the precedence re-arrangement in RnTypes
140 -- It's important that a * (b + c) doesn't get rearranged to (a*b) + c!
142 -- However, NB that toHsType doesn't add HsParTys (in an effort to keep
143 -- interface files smaller), so when printing a HsType we may need to
146 | HsNumTy Integer -- Generics only
148 | HsPredTy (HsPred name) -- Only used in the type of an instance
149 -- declaration, eg. Eq [a] -> Eq a
152 -- Note no need for location info on the
153 -- enclosed HsPred; the one on the type will do
155 | HsKindSig (LHsType name) -- (ty :: kind)
156 Kind -- A type with a kind signature
158 | HsSpliceTy (HsSplice name)
160 | HsDocTy (LHsType name) LHsDocString -- A documented type
162 | HsSpliceTyOut Kind -- Used just like KindedTyVar, just between
163 -- kcHsType and dsHsType
165 | HsBangTy HsBang (LHsType name) -- Bang-style type annotations
166 | HsRecTy [ConDeclField name] -- Only in data type declarations
168 data HsExplicitForAll = Explicit | Implicit
172 data ConDeclField name -- Record fields have Haddoc docs on them
173 = ConDeclField { cd_fld_name :: Located name,
174 cd_fld_type :: LBangType name,
175 cd_fld_doc :: Maybe LHsDocString }
178 -----------------------
179 -- Combine adjacent for-alls.
180 -- The following awkward situation can happen otherwise:
181 -- f :: forall a. ((Num a) => Int)
182 -- might generate HsForAll (Just [a]) [] (HsForAll Nothing [Num a] t)
183 -- Then a isn't discovered as ambiguous, and we abstract the AbsBinds wrt []
184 -- but the export list abstracts f wrt [a]. Disaster.
186 -- A valid type must have one for-all at the top of the type, or of the fn arg types
188 mkImplicitHsForAllTy :: LHsContext name -> LHsType name -> HsType name
189 mkExplicitHsForAllTy :: [LHsTyVarBndr name] -> LHsContext name -> LHsType name -> HsType name
190 mkImplicitHsForAllTy ctxt ty = mkHsForAllTy Implicit [] ctxt ty
191 mkExplicitHsForAllTy tvs ctxt ty = mkHsForAllTy Explicit tvs ctxt ty
193 mkHsForAllTy :: HsExplicitForAll -> [LHsTyVarBndr name] -> LHsContext name -> LHsType name -> HsType name
194 -- Smart constructor for HsForAllTy
195 mkHsForAllTy exp tvs (L _ []) ty = mk_forall_ty exp tvs ty
196 mkHsForAllTy exp tvs ctxt ty = HsForAllTy exp tvs ctxt ty
198 -- mk_forall_ty makes a pure for-all type (no context)
199 mk_forall_ty :: HsExplicitForAll -> [LHsTyVarBndr name] -> LHsType name -> HsType name
200 mk_forall_ty exp tvs (L _ (HsParTy ty)) = mk_forall_ty exp tvs ty
201 mk_forall_ty exp1 tvs1 (L _ (HsForAllTy exp2 tvs2 ctxt ty)) = mkHsForAllTy (exp1 `plus` exp2) (tvs1 ++ tvs2) ctxt ty
202 mk_forall_ty exp tvs ty = HsForAllTy exp tvs (L noSrcSpan []) ty
203 -- Even if tvs is empty, we still make a HsForAll!
204 -- In the Implicit case, this signals the place to do implicit quantification
205 -- In the Explicit case, it prevents implicit quantification
206 -- (see the sigtype production in Parser.y.pp)
207 -- so that (forall. ty) isn't implicitly quantified
209 plus :: HsExplicitForAll -> HsExplicitForAll -> HsExplicitForAll
210 Implicit `plus` Implicit = Implicit
211 _ `plus` _ = Explicit
213 hsExplicitTvs :: LHsType name -> [name]
214 -- The explicitly-given forall'd type variables of a HsType
215 hsExplicitTvs (L _ (HsForAllTy Explicit tvs _ _)) = hsLTyVarNames tvs
218 ---------------------
219 type LHsTyVarBndr name = Located (HsTyVarBndr name)
221 data HsTyVarBndr name
223 | KindedTyVar name Kind
224 -- *** NOTA BENE *** A "monotype" in a pragma can have
225 -- for-alls in it, (mostly to do with dictionaries). These
226 -- must be explicitly Kinded.
228 hsTyVarName :: HsTyVarBndr name -> name
229 hsTyVarName (UserTyVar n) = n
230 hsTyVarName (KindedTyVar n _) = n
232 hsLTyVarName :: LHsTyVarBndr name -> name
233 hsLTyVarName = hsTyVarName . unLoc
235 hsTyVarNames :: [HsTyVarBndr name] -> [name]
236 hsTyVarNames tvs = map hsTyVarName tvs
238 hsLTyVarNames :: [LHsTyVarBndr name] -> [name]
239 hsLTyVarNames = map hsLTyVarName
241 hsLTyVarLocName :: LHsTyVarBndr name -> Located name
242 hsLTyVarLocName = fmap hsTyVarName
244 hsLTyVarLocNames :: [LHsTyVarBndr name] -> [Located name]
245 hsLTyVarLocNames = map hsLTyVarLocName
247 replaceTyVarName :: HsTyVarBndr name1 -> name2 -> HsTyVarBndr name2
248 replaceTyVarName (UserTyVar _) n' = UserTyVar n'
249 replaceTyVarName (KindedTyVar _ k) n' = KindedTyVar n' k
255 :: OutputableBndr name
257 -> ([LHsTyVarBndr name], HsContext name, name, [LHsType name])
258 -- Split up an instance decl type, returning the pieces
260 splitHsInstDeclTy inst_ty
262 HsParTy (L _ ty) -> splitHsInstDeclTy ty
263 HsForAllTy _ tvs cxt (L _ ty) -> split_tau tvs (unLoc cxt) ty
264 other -> split_tau [] [] other
265 -- The type vars should have been computed by now, even if they were implicit
267 split_tau tvs cxt (HsPredTy (HsClassP cls tys)) = (tvs, cxt, cls, tys)
268 split_tau tvs cxt (HsParTy (L _ ty)) = split_tau tvs cxt ty
269 split_tau _ _ _ = pprPanic "splitHsInstDeclTy" (ppr inst_ty)
271 -- Splits HsType into the (init, last) parts
272 -- Breaks up any parens in the result type:
273 -- splitHsFunType (a -> (b -> c)) = ([a,b], c)
274 splitHsFunType :: LHsType name -> ([LHsType name], LHsType name)
275 splitHsFunType (L _ (HsFunTy x y)) = (x:args, res)
277 (args, res) = splitHsFunType y
278 splitHsFunType (L _ (HsParTy ty)) = splitHsFunType ty
279 splitHsFunType other = ([], other)
283 %************************************************************************
285 \subsection{Pretty printing}
287 %************************************************************************
290 instance (OutputableBndr name) => Outputable (HsType name) where
291 ppr ty = pprHsType ty
293 instance (Outputable name) => Outputable (HsTyVarBndr name) where
294 ppr (UserTyVar name) = ppr name
295 ppr (KindedTyVar name kind) = pprHsTyVarBndr name kind
297 instance OutputableBndr name => Outputable (HsPred name) where
298 ppr (HsClassP clas tys) = ppr clas <+> hsep (map pprLHsType tys)
299 ppr (HsEqualP t1 t2) = hsep [pprLHsType t1, ptext (sLit "~"),
301 ppr (HsIParam n ty) = hsep [ppr n, dcolon, ppr ty]
303 pprLHsType :: OutputableBndr name => LHsType name -> SDoc
304 pprLHsType = pprParendHsType . unLoc
306 pprHsTyVarBndr :: Outputable name => name -> Kind -> SDoc
307 pprHsTyVarBndr name kind | isLiftedTypeKind kind = ppr name
308 | otherwise = hsep [ppr name, dcolon, pprParendKind kind]
310 pprHsForAll :: OutputableBndr name => HsExplicitForAll -> [LHsTyVarBndr name] -> LHsContext name -> SDoc
311 pprHsForAll exp tvs cxt
312 | show_forall = forall_part <+> pprHsContext (unLoc cxt)
313 | otherwise = pprHsContext (unLoc cxt)
315 show_forall = opt_PprStyle_Debug
316 || (not (null tvs) && is_explicit)
317 is_explicit = case exp of {Explicit -> True; Implicit -> False}
318 forall_part = ptext (sLit "forall") <+> interppSP tvs <> dot
320 pprHsContext :: (OutputableBndr name) => HsContext name -> SDoc
321 pprHsContext [] = empty
322 pprHsContext cxt = ppr_hs_context cxt <+> ptext (sLit "=>")
324 ppr_hs_context :: (OutputableBndr name) => HsContext name -> SDoc
325 ppr_hs_context [] = empty
326 ppr_hs_context cxt = parens (interpp'SP cxt)
328 pprConDeclFields :: OutputableBndr name => [ConDeclField name] -> SDoc
329 pprConDeclFields fields = braces (sep (punctuate comma (map ppr_fld fields)))
331 ppr_fld (ConDeclField { cd_fld_name = n, cd_fld_type = ty,
333 = ppr n <+> dcolon <+> ppr ty <+> ppr_mbDoc doc
337 pREC_TOP, pREC_FUN, pREC_OP, pREC_CON :: Int
338 pREC_TOP = 0 -- type in ParseIface.y
339 pREC_FUN = 1 -- btype in ParseIface.y
340 -- Used for LH arg of (->)
341 pREC_OP = 2 -- Used for arg of any infix operator
342 -- (we don't keep their fixities around)
343 pREC_CON = 3 -- Used for arg of type applicn:
344 -- always parenthesise unless atomic
346 maybeParen :: Int -- Precedence of context
347 -> Int -- Precedence of top-level operator
348 -> SDoc -> SDoc -- Wrap in parens if (ctxt >= op)
349 maybeParen ctxt_prec op_prec p | ctxt_prec >= op_prec = parens p
352 -- printing works more-or-less as for Types
354 pprHsType, pprParendHsType :: (OutputableBndr name) => HsType name -> SDoc
356 pprHsType ty = getPprStyle $ \sty -> ppr_mono_ty pREC_TOP (prepare sty ty)
357 pprParendHsType ty = ppr_mono_ty pREC_CON ty
359 -- Before printing a type
360 -- (a) Remove outermost HsParTy parens
361 -- (b) Drop top-level for-all type variables in user style
362 -- since they are implicit in Haskell
363 prepare :: PprStyle -> HsType name -> HsType name
364 prepare sty (HsParTy ty) = prepare sty (unLoc ty)
367 ppr_mono_lty :: (OutputableBndr name) => Int -> LHsType name -> SDoc
368 ppr_mono_lty ctxt_prec ty = ppr_mono_ty ctxt_prec (unLoc ty)
370 ppr_mono_ty :: (OutputableBndr name) => Int -> HsType name -> SDoc
371 ppr_mono_ty ctxt_prec (HsForAllTy exp tvs ctxt ty)
372 = maybeParen ctxt_prec pREC_FUN $
373 sep [pprHsForAll exp tvs ctxt, ppr_mono_lty pREC_TOP ty]
375 ppr_mono_ty _ (HsBangTy b ty) = ppr b <> ppr ty
376 ppr_mono_ty _ (HsRecTy flds) = pprConDeclFields flds
377 ppr_mono_ty _ (HsTyVar name) = ppr name
378 ppr_mono_ty prec (HsFunTy ty1 ty2) = ppr_fun_ty prec ty1 ty2
379 ppr_mono_ty _ (HsTupleTy con tys) = tupleParens con (interpp'SP tys)
380 ppr_mono_ty _ (HsKindSig ty kind) = parens (ppr_mono_lty pREC_TOP ty <+> dcolon <+> pprKind kind)
381 ppr_mono_ty _ (HsListTy ty) = brackets (ppr_mono_lty pREC_TOP ty)
382 ppr_mono_ty _ (HsPArrTy ty) = pabrackets (ppr_mono_lty pREC_TOP ty)
383 ppr_mono_ty _ (HsPredTy pred) = ppr pred
384 ppr_mono_ty _ (HsNumTy n) = integer n -- generics only
385 ppr_mono_ty _ (HsSpliceTy s) = pprSplice s
386 ppr_mono_ty _ (HsSpliceTyOut k) = text "<splicety>" <> dcolon <> ppr k
388 ppr_mono_ty ctxt_prec (HsAppTy fun_ty arg_ty)
389 = maybeParen ctxt_prec pREC_CON $
390 hsep [ppr_mono_lty pREC_FUN fun_ty, ppr_mono_lty pREC_CON arg_ty]
392 ppr_mono_ty ctxt_prec (HsOpTy ty1 op ty2)
393 = maybeParen ctxt_prec pREC_OP $
394 ppr_mono_lty pREC_OP ty1 <+> ppr op <+> ppr_mono_lty pREC_OP ty2
396 ppr_mono_ty _ (HsParTy ty)
397 = parens (ppr_mono_lty pREC_TOP ty)
398 -- Put the parens in where the user did
399 -- But we still use the precedence stuff to add parens because
400 -- toHsType doesn't put in any HsParTys, so we may still need them
402 ppr_mono_ty ctxt_prec (HsDocTy ty doc)
403 = maybeParen ctxt_prec pREC_OP $
404 ppr_mono_lty pREC_OP ty <+> ppr (unLoc doc)
405 -- we pretty print Haddock comments on types as if they were
408 --------------------------
409 ppr_fun_ty :: (OutputableBndr name) => Int -> LHsType name -> LHsType name -> SDoc
410 ppr_fun_ty ctxt_prec ty1 ty2
411 = let p1 = ppr_mono_lty pREC_FUN ty1
412 p2 = ppr_mono_lty pREC_TOP ty2
414 maybeParen ctxt_prec pREC_FUN $
415 sep [p1, ptext (sLit "->") <+> p2]
417 --------------------------
418 pabrackets :: SDoc -> SDoc
419 pabrackets p = ptext (sLit "[:") <> p <> ptext (sLit ":]")