Mainly, rename LiteralTy to LitTy
[ghc.git] / compiler / iface / IfaceType.lhs
1 %
2 % (c) The University of Glasgow 2006
3 % (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
4 %
5
6 This module defines interface types and binders
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 module IfaceType (
17         IfExtName, IfLclName, IfIPName,
18
19         IfaceType(..), IfacePredType, IfaceKind, IfaceTyCon(..), IfaceCoCon(..),
20         IfaceTyLit(..),
21         IfaceContext, IfaceBndr(..), IfaceTvBndr, IfaceIdBndr, IfaceCoercion,
22         ifaceTyConName,
23
24         -- Conversion from Type -> IfaceType
25         toIfaceType, toIfaceKind, toIfaceContext,
26         toIfaceBndr, toIfaceIdBndr, toIfaceTvBndrs, 
27         toIfaceTyCon, toIfaceTyCon_name,
28
29         -- Conversion from Coercion -> IfaceType
30         coToIfaceType,
31
32         -- Printing
33         pprIfaceType, pprParendIfaceType, pprIfaceContext,
34         pprIfaceIdBndr, pprIfaceTvBndr, pprIfaceTvBndrs, pprIfaceBndrs,
35         tOP_PREC, tYCON_PREC, noParens, maybeParen, pprIfaceForAllPart
36
37     ) where
38
39 import Coercion
40 import TypeRep hiding( maybeParen )
41 import Type (tyConAppTyCon_maybe)
42 import IParam (ipFastString)
43 import TyCon
44 import Id
45 import Var
46 import TysWiredIn
47 import TysPrim
48 import Name
49 import BasicTypes
50 import Outputable
51 import FastString
52 \end{code}
53
54 %************************************************************************
55 %*                                                                      *
56                 Local (nested) binders
57 %*                                                                      *
58 %************************************************************************
59
60 \begin{code}
61 type IfLclName = FastString     -- A local name in iface syntax
62
63 type IfExtName = Name   -- An External or WiredIn Name can appear in IfaceSyn
64                         -- (However Internal or System Names never should)
65
66 type IfIPName = FastString -- Represent implicit parameters simply as a string
67
68 data IfaceBndr          -- Local (non-top-level) binders
69   = IfaceIdBndr {-# UNPACK #-} !IfaceIdBndr
70   | IfaceTvBndr {-# UNPACK #-} !IfaceTvBndr
71
72 type IfaceIdBndr  = (IfLclName, IfaceType)
73 type IfaceTvBndr  = (IfLclName, IfaceKind)
74
75 -------------------------------
76 type IfaceKind     = IfaceType
77 type IfaceCoercion = IfaceType
78
79 data IfaceType     -- A kind of universal type, used for types, kinds, and coercions
80   = IfaceTyVar    IfLclName                     -- Type/coercion variable only, not tycon
81   | IfaceAppTy    IfaceType IfaceType
82   | IfaceFunTy    IfaceType IfaceType
83   | IfaceForAllTy IfaceTvBndr IfaceType
84   | IfaceTyConApp IfaceTyCon [IfaceType]  -- Not necessarily saturated
85                                           -- Includes newtypes, synonyms, tuples
86   | IfaceCoConApp IfaceCoCon [IfaceType]  -- Always saturated
87   | IfaceLitTy IfaceTyLit
88
89 type IfacePredType = IfaceType
90 type IfaceContext = [IfacePredType]
91
92 data IfaceTyLit
93   = IfaceNumberTyLit Integer
94
95 data IfaceTyCon         -- Encodes type constructors, kind constructors
96                         -- coercion constructors, the lot
97   = IfaceTc IfExtName   -- The common case
98   | IfaceIntTc | IfaceBoolTc | IfaceCharTc
99   | IfaceListTc | IfacePArrTc
100   | IfaceTupTc TupleSort Arity 
101   | IfaceIPTc IfIPName       -- Used for implicit parameter TyCons
102
103   -- Kind constructors
104   | IfaceLiftedTypeKindTc | IfaceOpenTypeKindTc | IfaceUnliftedTypeKindTc
105   | IfaceUbxTupleKindTc | IfaceArgTypeKindTc | IfaceConstraintKindTc
106
107   -- SuperKind constructor
108   | IfaceSuperKindTc  -- IA0_NOTE: You might want to check if I didn't forget something.
109
110   -- Coercion constructors
111 data IfaceCoCon
112   = IfaceCoAx IfExtName
113   | IfaceIPCoAx FastString
114   | IfaceReflCo    | IfaceUnsafeCo  | IfaceSymCo
115   | IfaceTransCo   | IfaceInstCo
116   | IfaceNthCo Int
117
118 ifaceTyConName :: IfaceTyCon -> Name
119 ifaceTyConName IfaceIntTc              = intTyConName
120 ifaceTyConName IfaceBoolTc             = boolTyConName
121 ifaceTyConName IfaceCharTc             = charTyConName
122 ifaceTyConName IfaceListTc             = listTyConName
123 ifaceTyConName IfacePArrTc             = parrTyConName
124 ifaceTyConName (IfaceTupTc bx ar)      = getName (tupleTyCon bx ar)
125 ifaceTyConName IfaceLiftedTypeKindTc   = liftedTypeKindTyConName
126 ifaceTyConName IfaceOpenTypeKindTc     = openTypeKindTyConName
127 ifaceTyConName IfaceUnliftedTypeKindTc = unliftedTypeKindTyConName
128 ifaceTyConName IfaceUbxTupleKindTc     = ubxTupleKindTyConName
129 ifaceTyConName IfaceArgTypeKindTc      = argTypeKindTyConName
130 ifaceTyConName IfaceConstraintKindTc   = constraintKindTyConName
131 ifaceTyConName IfaceSuperKindTc        = tySuperKindTyConName
132 ifaceTyConName (IfaceTc ext)           = ext
133 ifaceTyConName (IfaceIPTc n)           = pprPanic "ifaceTyConName:IPTc" (ppr n)
134                                          -- Note [The Name of an IfaceAnyTc]
135 \end{code}
136
137 Note [The Name of an IfaceAnyTc]
138 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
139 IA0_NOTE: This is an old comment. It needs to be updated with IPTc which
140 I don't know about.
141
142 It isn't easy to get the Name of an IfaceAnyTc in a pure way.  What you
143 really need to do is to transform it to a TyCon, and get the Name of that.
144 But doing so needs the monad because there's an IfaceKind inside, and we
145 need a Kind.
146
147 In fact, ifaceTyConName is only used for instances and rules, and we don't
148 expect to instantiate those at these (internal-ish) Any types, so rather
149 than solve this potential problem now, I'm going to defer it until it happens!
150
151 %************************************************************************
152 %*                                                                      *
153                 Functions over IFaceTypes
154 %*                                                                      *
155 %************************************************************************
156
157
158 \begin{code}
159 splitIfaceSigmaTy :: IfaceType -> ([IfaceTvBndr], [IfacePredType], IfaceType)
160 -- Mainly for printing purposes
161 splitIfaceSigmaTy ty
162   = (tvs, theta, tau)
163   where
164     (tvs,   rho)   = split_foralls ty
165     (theta, tau)   = split_rho rho
166
167     split_foralls (IfaceForAllTy tv ty) 
168         = case split_foralls ty of { (tvs, rho) -> (tv:tvs, rho) }
169     split_foralls rho = ([], rho)
170
171     split_rho (IfaceFunTy ty1 ty2)
172       | isIfacePredTy ty1 = case split_rho ty2 of { (ps, tau) -> (ty1:ps, tau) }
173     split_rho tau = ([], tau)
174 \end{code}
175
176 %************************************************************************
177 %*                                                                      *
178                 Pretty-printing
179 %*                                                                      *
180 %************************************************************************
181
182 Precedence
183 ~~~~~~~~~~
184 @ppr_ty@ takes an @Int@ that is the precedence of the context.
185 The precedence levels are:
186 \begin{description}
187 \item[tOP_PREC]   No parens required.
188 \item[fUN_PREC]   Left hand argument of a function arrow.
189 \item[tYCON_PREC] Argument of a type constructor.
190 \end{description}
191
192 \begin{code}
193 tOP_PREC, fUN_PREC, tYCON_PREC :: Int
194 tOP_PREC    = 0 -- type   in ParseIface.y
195 fUN_PREC    = 1 -- btype  in ParseIface.y
196 tYCON_PREC  = 2 -- atype  in ParseIface.y
197
198 noParens :: SDoc -> SDoc
199 noParens pp = pp
200
201 maybeParen :: Int -> Int -> SDoc -> SDoc
202 maybeParen ctxt_prec inner_prec pretty
203   | ctxt_prec < inner_prec = pretty
204   | otherwise              = parens pretty
205 \end{code}
206
207
208 ----------------------------- Printing binders ------------------------------------
209
210 \begin{code}
211 instance Outputable IfaceBndr where
212     ppr (IfaceIdBndr bndr) = pprIfaceIdBndr bndr
213     ppr (IfaceTvBndr bndr) = char '@' <+> pprIfaceTvBndr bndr
214
215 pprIfaceBndrs :: [IfaceBndr] -> SDoc
216 pprIfaceBndrs bs = sep (map ppr bs)
217
218 pprIfaceIdBndr :: (IfLclName, IfaceType) -> SDoc
219 pprIfaceIdBndr (name, ty) = hsep [ppr name, dcolon, ppr ty]
220
221 pprIfaceTvBndr :: IfaceTvBndr -> SDoc
222 pprIfaceTvBndr (tv, IfaceTyConApp IfaceLiftedTypeKindTc [])
223   = ppr tv
224 pprIfaceTvBndr (tv, kind) = parens (ppr tv <> dcolon <> ppr kind)
225 pprIfaceTvBndrs :: [IfaceTvBndr] -> SDoc
226 pprIfaceTvBndrs tyvars = hsep (map pprIfaceTvBndr tyvars)
227 \end{code}
228
229 ----------------------------- Printing IfaceType ------------------------------------
230
231 \begin{code}
232 ---------------------------------
233 instance Outputable IfaceType where
234   ppr ty = pprIfaceType ty
235
236 pprIfaceType, pprParendIfaceType ::IfaceType -> SDoc
237 pprIfaceType       = ppr_ty tOP_PREC
238 pprParendIfaceType = ppr_ty tYCON_PREC
239
240 isIfacePredTy :: IfaceType -> Bool
241 isIfacePredTy _  = False
242 -- FIXME: fix this to print iface pred tys correctly
243 -- isIfacePredTy ty = ifaceTypeKind ty `eqKind` constraintKind
244
245 ppr_ty :: Int -> IfaceType -> SDoc
246 ppr_ty _         (IfaceTyVar tyvar)     = ppr tyvar
247 ppr_ty ctxt_prec (IfaceTyConApp tc tys) = ppr_tc_app ctxt_prec tc tys
248
249 ppr_ty _ (IfaceLitTy n) = ppr_tylit n
250
251 ppr_ty ctxt_prec (IfaceCoConApp tc tys) 
252   = maybeParen ctxt_prec tYCON_PREC 
253                (sep [ppr tc, nest 4 (sep (map pprParendIfaceType tys))])
254
255         -- Function types
256 ppr_ty ctxt_prec (IfaceFunTy ty1 ty2)
257   = -- We don't want to lose synonyms, so we mustn't use splitFunTys here.
258     maybeParen ctxt_prec fUN_PREC $
259     sep (ppr_ty fUN_PREC ty1 : ppr_fun_tail ty2)
260   where
261     arr | isIfacePredTy ty1 = darrow
262         | otherwise         = arrow
263
264     ppr_fun_tail (IfaceFunTy ty1 ty2) 
265       = (arr <+> ppr_ty fUN_PREC ty1) : ppr_fun_tail ty2
266     ppr_fun_tail other_ty
267       = [arr <+> pprIfaceType other_ty]
268
269 ppr_ty ctxt_prec (IfaceAppTy ty1 ty2)
270   = maybeParen ctxt_prec tYCON_PREC $
271     ppr_ty fUN_PREC ty1 <+> pprParendIfaceType ty2
272
273 ppr_ty ctxt_prec ty@(IfaceForAllTy _ _)
274   = maybeParen ctxt_prec fUN_PREC (pprIfaceForAllPart tvs theta (pprIfaceType tau))
275  where          
276     (tvs, theta, tau) = splitIfaceSigmaTy ty
277      
278  -------------------
279 pprIfaceForAllPart :: [IfaceTvBndr] -> IfaceContext -> SDoc -> SDoc
280 pprIfaceForAllPart tvs ctxt doc 
281   = sep [ppr_tvs, pprIfaceContext ctxt, doc]
282   where
283     ppr_tvs | null tvs  = empty
284             | otherwise = ptext (sLit "forall") <+> pprIfaceTvBndrs tvs <> dot
285
286 -------------------
287 ppr_tc_app :: Int -> IfaceTyCon -> [IfaceType] -> SDoc
288 ppr_tc_app _         tc          []   = ppr_tc tc
289
290 ppr_tc_app _         IfaceListTc [ty] = brackets (pprIfaceType ty)
291 ppr_tc_app _         IfaceListTc _    = panic "ppr_tc_app IfaceListTc"
292
293 ppr_tc_app _         IfacePArrTc [ty] = pabrackets (pprIfaceType ty)
294 ppr_tc_app _         IfacePArrTc _    = panic "ppr_tc_app IfacePArrTc"
295
296 ppr_tc_app _         (IfaceTupTc sort _) tys =
297   tupleParens sort (sep (punctuate comma (map pprIfaceType tys)))
298
299 ppr_tc_app _         (IfaceIPTc n) [ty] =
300   parens (ppr n <> dcolon <> pprIfaceType ty)
301 ppr_tc_app _         (IfaceIPTc _) _ = panic "ppr_tc_app IfaceIPTc"
302
303 ppr_tc_app ctxt_prec tc tys
304   = maybeParen ctxt_prec tYCON_PREC 
305                (sep [ppr_tc tc, nest 4 (sep (map pprParendIfaceType tys))])
306
307 ppr_tc :: IfaceTyCon -> SDoc
308 -- Wrap infix type constructors in parens
309 ppr_tc tc@(IfaceTc ext_nm) = parenSymOcc (getOccName ext_nm) (ppr tc)
310 ppr_tc tc                  = ppr tc
311
312 ppr_tylit :: IfaceTyLit -> SDoc
313 ppr_tylit (IfaceNumberTyLit n) = integer n
314
315 -------------------
316 instance Outputable IfaceTyCon where
317   ppr (IfaceIPTc n)  = ppr (IPName n)
318   ppr other_tc       = ppr (ifaceTyConName other_tc)
319
320 instance Outputable IfaceCoCon where
321   ppr (IfaceCoAx n)    = ppr n
322   ppr (IfaceIPCoAx ip) = ppr (IPName ip)
323   ppr IfaceReflCo      = ptext (sLit "Refl")
324   ppr IfaceUnsafeCo    = ptext (sLit "Unsafe")
325   ppr IfaceSymCo       = ptext (sLit "Sym")
326   ppr IfaceTransCo     = ptext (sLit "Trans")
327   ppr IfaceInstCo      = ptext (sLit "Inst")
328   ppr (IfaceNthCo d)   = ptext (sLit "Nth:") <> int d
329
330 instance Outputable IfaceTyLit where
331   ppr = ppr_tylit
332
333 -------------------
334 pprIfaceContext :: IfaceContext -> SDoc
335 -- Prints "(C a, D b) =>", including the arrow
336 pprIfaceContext []    = empty
337 pprIfaceContext theta = ppr_preds theta <+> darrow
338
339 ppr_preds :: [IfacePredType] -> SDoc
340 ppr_preds [pred] = ppr pred    -- No parens
341 ppr_preds preds  = parens (sep (punctuate comma (map ppr preds))) 
342
343 -------------------
344 pabrackets :: SDoc -> SDoc
345 pabrackets p = ptext (sLit "[:") <> p <> ptext (sLit ":]")
346 \end{code}
347
348 %************************************************************************
349 %*                                                                      *
350         Conversion from Type to IfaceType
351 %*                                                                      *
352 %************************************************************************
353
354 \begin{code}
355 ----------------
356 toIfaceTvBndr :: TyVar -> (IfLclName, IfaceType)
357 toIfaceTvBndr tyvar   = (occNameFS (getOccName tyvar), toIfaceKind (tyVarKind tyvar))
358 toIfaceIdBndr :: Id -> (IfLclName, IfaceType)
359 toIfaceIdBndr id      = (occNameFS (getOccName id),    toIfaceType (idType id))
360 toIfaceTvBndrs :: [TyVar] -> [(IfLclName, IfaceType)]
361 toIfaceTvBndrs tyvars = map toIfaceTvBndr tyvars
362
363 toIfaceBndr :: Var -> IfaceBndr
364 toIfaceBndr var
365   | isId var  = IfaceIdBndr (toIfaceIdBndr var)
366   | otherwise = IfaceTvBndr (toIfaceTvBndr var)
367
368 toIfaceKind :: Type -> IfaceType
369 toIfaceKind = toIfaceType
370
371 ---------------------
372 toIfaceType :: Type -> IfaceType
373 -- Synonyms are retained in the interface type
374 toIfaceType (TyVarTy tv)      = IfaceTyVar (toIfaceTyVar tv)
375 toIfaceType (AppTy t1 t2)     = IfaceAppTy (toIfaceType t1) (toIfaceType t2)
376 toIfaceType (FunTy t1 t2)     = IfaceFunTy (toIfaceType t1) (toIfaceType t2)
377 toIfaceType (TyConApp tc tys) = IfaceTyConApp (toIfaceTyCon tc) (toIfaceTypes tys)
378 toIfaceType (LitTy n)         = IfaceLitTy (toIfaceTyLit n)
379 toIfaceType (ForAllTy tv t)   = IfaceForAllTy (toIfaceTvBndr tv) (toIfaceType t)
380
381 toIfaceTyVar :: TyVar -> FastString
382 toIfaceTyVar = occNameFS . getOccName
383
384 toIfaceCoVar :: CoVar -> FastString
385 toIfaceCoVar = occNameFS . getOccName
386
387 ----------------
388 toIfaceTyCon :: TyCon -> IfaceTyCon
389 toIfaceTyCon tc 
390   | isTupleTyCon tc            = IfaceTupTc (tupleTyConSort tc) (tyConArity tc)
391   | Just n <- tyConIP_maybe tc = IfaceIPTc (ipFastString n)
392   | otherwise                  = toIfaceTyCon_name (tyConName tc)
393
394 toIfaceTyCon_name :: Name -> IfaceTyCon
395 toIfaceTyCon_name nm
396   | Just (ATyCon tc) <- wiredInNameTyThing_maybe nm
397   = toIfaceWiredInTyCon tc nm
398   | otherwise
399   = IfaceTc nm
400
401 toIfaceWiredInTyCon :: TyCon -> Name -> IfaceTyCon
402 toIfaceWiredInTyCon tc nm
403   | isTupleTyCon tc                 = IfaceTupTc  (tupleTyConSort tc) (tyConArity tc)
404   | Just n <- tyConIP_maybe tc      = IfaceIPTc (ipFastString n)
405   | nm == intTyConName              = IfaceIntTc
406   | nm == boolTyConName             = IfaceBoolTc 
407   | nm == charTyConName             = IfaceCharTc 
408   | nm == listTyConName             = IfaceListTc 
409   | nm == parrTyConName             = IfacePArrTc 
410   | nm == liftedTypeKindTyConName   = IfaceLiftedTypeKindTc
411   | nm == unliftedTypeKindTyConName = IfaceUnliftedTypeKindTc
412   | nm == openTypeKindTyConName     = IfaceOpenTypeKindTc
413   | nm == argTypeKindTyConName      = IfaceArgTypeKindTc
414   | nm == constraintKindTyConName   = IfaceConstraintKindTc
415   | nm == ubxTupleKindTyConName     = IfaceUbxTupleKindTc
416   | nm == tySuperKindTyConName      = IfaceSuperKindTc
417   | otherwise                       = IfaceTc nm
418
419 toIfaceTyLit :: TyLit -> IfaceTyLit
420 toIfaceTyLit (NumberTyLit x) = IfaceNumberTyLit x
421
422 ----------------
423 toIfaceTypes :: [Type] -> [IfaceType]
424 toIfaceTypes ts = map toIfaceType ts
425
426 ----------------
427 toIfaceContext :: ThetaType -> IfaceContext
428 toIfaceContext = toIfaceTypes
429
430 ----------------
431 coToIfaceType :: Coercion -> IfaceType
432 coToIfaceType (Refl ty)             = IfaceCoConApp IfaceReflCo [toIfaceType ty]
433 coToIfaceType (TyConAppCo tc cos)   = IfaceTyConApp (toIfaceTyCon tc) 
434                                                     (map coToIfaceType cos)
435 coToIfaceType (AppCo co1 co2)       = IfaceAppTy    (coToIfaceType co1) 
436                                                     (coToIfaceType co2)
437 coToIfaceType (ForAllCo v co)       = IfaceForAllTy (toIfaceTvBndr v) 
438                                                     (coToIfaceType co)
439 coToIfaceType (CoVarCo cv)          = IfaceTyVar  (toIfaceCoVar cv)
440 coToIfaceType (AxiomInstCo con cos) = IfaceCoConApp (coAxiomToIfaceType con)
441                                                     (map coToIfaceType cos)
442 coToIfaceType (UnsafeCo ty1 ty2)    = IfaceCoConApp IfaceUnsafeCo 
443                                                     [ toIfaceType ty1
444                                                     , toIfaceType ty2 ]
445 coToIfaceType (SymCo co)            = IfaceCoConApp IfaceSymCo 
446                                                     [ coToIfaceType co ]
447 coToIfaceType (TransCo co1 co2)     = IfaceCoConApp IfaceTransCo
448                                                     [ coToIfaceType co1
449                                                     , coToIfaceType co2 ]
450 coToIfaceType (NthCo d co)          = IfaceCoConApp (IfaceNthCo d)
451                                                     [ coToIfaceType co ]
452 coToIfaceType (InstCo co ty)        = IfaceCoConApp IfaceInstCo 
453                                                     [ coToIfaceType co
454                                                     , toIfaceType ty ]
455
456 coAxiomToIfaceType :: CoAxiom -> IfaceCoCon
457 coAxiomToIfaceType con
458   | Just tc <- tyConAppTyCon_maybe (co_ax_lhs con)
459   , Just ip <- tyConIP_maybe tc
460   = IfaceIPCoAx (ipFastString ip)
461   | otherwise
462   = IfaceCoAx (coAxiomName con)
463 \end{code}
464