[project @ 2004-11-09 12:41:18 by simonpj]
[ghc-hetmet.git] / ghc / compiler / types / TypeRep.lhs
1 %
2 % (c) The GRASP/AQUA Project, Glasgow University, 1998
3 %
4 \section[TypeRep]{Type - friends' interface}
5
6 \begin{code}
7 module TypeRep (
8         TyThing(..), 
9         Type(..), TyNote(..),           -- Representation visible 
10         PredType(..),                   -- to friends
11         
12         Kind, ThetaType,                -- Synonyms
13
14         funTyCon,
15
16         -- Pretty-printing
17         pprType, pprParendType, pprTyThingCategory,
18         pprPred, pprTheta, pprThetaArrow, pprClassPred,
19
20         -- Re-export fromKind
21         liftedTypeKind, unliftedTypeKind, openTypeKind,
22         isLiftedTypeKind, isUnliftedTypeKind, isOpenTypeKind, 
23         mkArrowKind, mkArrowKinds,
24         pprKind, pprParendKind
25     ) where
26
27 #include "HsVersions.h"
28
29 import {-# SOURCE #-} DataCon( DataCon, dataConName )
30
31 -- friends:
32 import Kind
33 import Var        ( Var, Id, TyVar, tyVarKind )
34 import VarSet     ( TyVarSet )
35 import Name       ( Name, NamedThing(..), BuiltInSyntax(..), mkWiredInName )
36 import OccName    ( mkOccFS, tcName )
37 import BasicTypes ( IPName, tupleParens )
38 import TyCon      ( TyCon, mkFunTyCon, tyConArity, tupleTyConBoxity, isTupleTyCon, isRecursiveTyCon, isNewTyCon )
39 import Class      ( Class )
40
41 -- others
42 import PrelNames  ( gHC_PRIM, funTyConKey, listTyConKey, parrTyConKey, hasKey )
43 import Outputable
44 \end{code}
45
46 %************************************************************************
47 %*                                                                      *
48 \subsection{Type Classifications}
49 %*                                                                      *
50 %************************************************************************
51
52 A type is
53
54         *unboxed*       iff its representation is other than a pointer
55                         Unboxed types are also unlifted.
56
57         *lifted*        A type is lifted iff it has bottom as an element.
58                         Closures always have lifted types:  i.e. any
59                         let-bound identifier in Core must have a lifted
60                         type.  Operationally, a lifted object is one that
61                         can be entered.
62
63                         Only lifted types may be unified with a type variable.
64
65         *algebraic*     A type with one or more constructors, whether declared
66                         with "data" or "newtype".   
67                         An algebraic type is one that can be deconstructed
68                         with a case expression.  
69                         *NOT* the same as lifted types,  because we also 
70                         include unboxed tuples in this classification.
71
72         *data*          A type declared with "data".  Also boxed tuples.
73
74         *primitive*     iff it is a built-in type that can't be expressed
75                         in Haskell.
76
77 Currently, all primitive types are unlifted, but that's not necessarily
78 the case.  (E.g. Int could be primitive.)
79
80 Some primitive types are unboxed, such as Int#, whereas some are boxed
81 but unlifted (such as ByteArray#).  The only primitive types that we
82 classify as algebraic are the unboxed tuples.
83
84 examples of type classifications:
85
86 Type            primitive       boxed           lifted          algebraic    
87 -----------------------------------------------------------------------------
88 Int#,           Yes             No              No              No
89 ByteArray#      Yes             Yes             No              No
90 (# a, b #)      Yes             No              No              Yes
91 (  a, b  )      No              Yes             Yes             Yes
92 [a]             No              Yes             Yes             Yes
93
94
95
96         ----------------------
97         A note about newtypes
98         ----------------------
99
100 Consider
101         newtype N = MkN Int
102
103 Then we want N to be represented as an Int, and that's what we arrange.
104 The front end of the compiler [TcType.lhs] treats N as opaque, 
105 the back end treats it as transparent [Type.lhs].
106
107 There's a bit of a problem with recursive newtypes
108         newtype P = MkP P
109         newtype Q = MkQ (Q->Q)
110
111 Here the 'implicit expansion' we get from treating P and Q as transparent
112 would give rise to infinite types, which in turn makes eqType diverge.
113 Similarly splitForAllTys and splitFunTys can get into a loop.  
114
115 Solution: 
116
117 * Newtypes are always represented using TyConApp.
118
119 * For non-recursive newtypes, P, treat P just like a type synonym after 
120   type-checking is done; i.e. it's opaque during type checking (functions
121   from TcType) but transparent afterwards (functions from Type).  
122   "Treat P as a type synonym" means "all functions expand NewTcApps 
123   on the fly".
124
125   Applications of the data constructor P simply vanish:
126         P x = x
127   
128
129 * For recursive newtypes Q, treat the Q and its representation as 
130   distinct right through the compiler.  Applications of the data consructor
131   use a coerce:
132         Q = \(x::Q->Q). coerce Q x
133   They are rare, so who cares if they are a tiny bit less efficient.
134
135 The typechecker (TcTyDecls) identifies enough type construtors as 'recursive'
136 to cut all loops.  The other members of the loop may be marked 'non-recursive'.
137
138
139 %************************************************************************
140 %*                                                                      *
141 \subsection{The data type}
142 %*                                                                      *
143 %************************************************************************
144
145
146 \begin{code}
147 data Type
148   = TyVarTy TyVar       
149
150   | AppTy
151         Type            -- Function is *not* a TyConApp
152         Type            -- It must be another AppTy, or TyVarTy
153                         -- (or NoteTy of these)
154
155   | TyConApp            -- Application of a TyCon, including newtypes
156         TyCon           -- *Invariant* saturated appliations of FunTyCon and
157                         --      synonyms have their own constructors, below.
158                         -- However, *unsaturated* type synonyms, and FunTyCons
159                         --      do appear as TyConApps.  (Unsaturated type synonyms
160                         --      can appear as the RHS of a type synonym, for exmaple.)
161         [Type]          -- Might not be saturated.
162
163   | FunTy               -- Special case of TyConApp: TyConApp FunTyCon [t1,t2]
164         Type
165         Type
166
167   | ForAllTy            -- A polymorphic type
168         TyVar
169         Type    
170
171   | PredTy              -- A high level source type 
172         PredType        -- ...can be expanded to a representation type...
173
174   | NoteTy              -- A type with a note attached
175         TyNote
176         Type            -- The expanded version
177
178 data TyNote
179   = FTVNote TyVarSet    -- The free type variables of the noted expression
180
181   | SynNote Type        -- Used for type synonyms
182                         -- The Type is always a TyConApp, and is the un-expanded form.
183                         -- The type to which the note is attached is the expanded form.
184 \end{code}
185
186 -------------------------------------
187                 Source types
188
189 A type of the form
190         PredTy p
191 represents a value whose type is the Haskell predicate p, 
192 where a predicate is what occurs before the '=>' in a Haskell type.
193 It can be expanded into its representation, but: 
194
195         * The type checker must treat it as opaque
196         * The rest of the compiler treats it as transparent
197
198 Consider these examples:
199         f :: (Eq a) => a -> Int
200         g :: (?x :: Int -> Int) => a -> Int
201         h :: (r\l) => {r} => {l::Int | r}
202
203 Here the "Eq a" and "?x :: Int -> Int" and "r\l" are all called *predicates*
204 Predicates are represented inside GHC by PredType:
205
206 \begin{code}
207 data PredType 
208   = ClassP Class [Type]         -- Class predicate
209   | IParam (IPName Name) Type   -- Implicit parameter
210
211 type ThetaType = [PredType]
212 \end{code}
213
214 (We don't support TREX records yet, but the setup is designed
215 to expand to allow them.)
216
217 A Haskell qualified type, such as that for f,g,h above, is
218 represented using 
219         * a FunTy for the double arrow
220         * with a PredTy as the function argument
221
222 The predicate really does turn into a real extra argument to the
223 function.  If the argument has type (PredTy p) then the predicate p is
224 represented by evidence (a dictionary, for example, of type (predRepTy p).
225
226
227 %************************************************************************
228 %*                                                                      *
229                         TyThing
230 %*                                                                      *
231 %************************************************************************
232
233 Despite the fact that DataCon has to be imported via a hi-boot route, 
234 this module seems the right place for TyThing, because it's needed for
235 funTyCon and all the types in TysPrim.
236
237 \begin{code}
238 data TyThing = AnId     Id
239              | ADataCon DataCon
240              | ATyCon   TyCon
241              | AClass   Class
242
243 instance Outputable TyThing where
244   ppr thing = pprTyThingCategory thing <+> quotes (ppr (getName thing))
245
246 pprTyThingCategory :: TyThing -> SDoc
247 pprTyThingCategory (ATyCon _)   = ptext SLIT("Type constructor")
248 pprTyThingCategory (AClass _)   = ptext SLIT("Class")
249 pprTyThingCategory (AnId   _)   = ptext SLIT("Identifier")
250 pprTyThingCategory (ADataCon _) = ptext SLIT("Data constructor")
251
252 instance NamedThing TyThing where       -- Can't put this with the type
253   getName (AnId id)     = getName id    -- decl, because the DataCon instance
254   getName (ATyCon tc)   = getName tc    -- isn't visible there
255   getName (AClass cl)   = getName cl
256   getName (ADataCon dc) = dataConName dc
257 \end{code}
258
259
260 %************************************************************************
261 %*                                                                      *
262 \subsection{Wired-in type constructors
263 %*                                                                      *
264 %************************************************************************
265
266 We define a few wired-in type constructors here to avoid module knots
267
268 \begin{code}
269 funTyCon = mkFunTyCon funTyConName (mkArrowKinds [argTypeKind, openTypeKind] liftedTypeKind)
270         -- You might think that (->) should have type (?? -> ? -> *), and you'd be right
271         -- But if we do that we get kind errors when saying
272         --      instance Control.Arrow (->)
273         -- becuase the expected kind is (*->*->*).  The trouble is that the
274         -- expected/actual stuff in the unifier does not go contra-variant, whereas
275         -- the kind sub-typing does.  Sigh.  It really only matters if you use (->) in
276         -- a prefix way, thus:  (->) Int# Int#.  And this is unusual.
277
278 funTyConName = mkWiredInName gHC_PRIM
279                         (mkOccFS tcName FSLIT("(->)"))
280                         funTyConKey
281                         Nothing                 -- No parent object
282                         (ATyCon funTyCon)       -- Relevant TyCon
283                         BuiltInSyntax
284 \end{code}
285
286
287 %************************************************************************
288 %*                                                                      *
289 \subsection{The external interface}
290 %*                                                                      *
291 %************************************************************************
292
293 @pprType@ is the standard @Type@ printer; the overloaded @ppr@ function is
294 defined to use this.  @pprParendType@ is the same, except it puts
295 parens around the type, except for the atomic cases.  @pprParendType@
296 works just by setting the initial context precedence very high.
297
298 \begin{code}
299 data Prec = TopPrec     -- No parens
300           | FunPrec     -- Function args; no parens for tycon apps
301           | TyConPrec   -- Tycon args; no parens for atomic
302           deriving( Eq, Ord )
303
304 maybeParen :: Prec -> Prec -> SDoc -> SDoc
305 maybeParen ctxt_prec inner_prec pretty
306   | ctxt_prec < inner_prec = pretty
307   | otherwise              = parens pretty
308
309 ------------------
310 pprType, pprParendType :: Type -> SDoc
311 pprType       ty = ppr_type TopPrec   ty
312 pprParendType ty = ppr_type TyConPrec ty
313
314 ------------------
315 pprPred :: PredType -> SDoc
316 pprPred (ClassP cls tys) = pprClassPred cls tys
317 pprPred (IParam ip ty)   = ppr ip <> dcolon <> pprType ty
318
319 pprClassPred :: Class -> [Type] -> SDoc
320 pprClassPred clas tys = ppr clas <+> sep (map pprParendType tys)
321
322 pprTheta :: ThetaType -> SDoc
323 pprTheta theta = parens (sep (punctuate comma (map pprPred theta)))
324
325 pprThetaArrow :: ThetaType -> SDoc
326 pprThetaArrow theta 
327   | null theta = empty
328   | otherwise  = parens (sep (punctuate comma (map pprPred theta))) <+> ptext SLIT("=>")
329
330 ------------------
331 instance Outputable Type where
332     ppr ty = pprType ty
333
334 instance Outputable PredType where
335     ppr = pprPred
336
337 instance Outputable name => OutputableBndr (IPName name) where
338     pprBndr _ n = ppr n -- Simple for now
339
340 ------------------
341         -- OK, here's the main printer
342
343 ppr_type :: Prec -> Type -> SDoc
344 ppr_type p (TyVarTy tv)               = ppr tv
345 ppr_type p (PredTy pred)              = braces (ppr pred)
346 ppr_type p (NoteTy (SynNote ty1) ty2) = ppr_type p ty1
347 ppr_type p (NoteTy other         ty2) = ppr_type p ty2
348
349 ppr_type p (TyConApp tc tys) = ppr_tc_app p tc tys
350
351 ppr_type p (AppTy t1 t2) = maybeParen p TyConPrec $
352                            pprType t1 <+> ppr_type TyConPrec t2
353
354 ppr_type p ty@(ForAllTy _ _)       = ppr_forall_type p ty
355 ppr_type p ty@(FunTy (PredTy _) _) = ppr_forall_type p ty
356
357 ppr_type p (FunTy ty1 ty2)
358   = -- We don't want to lose synonyms, so we mustn't use splitFunTys here.
359     maybeParen p FunPrec $
360     sep (ppr_type FunPrec ty1 : ppr_fun_tail ty2)
361   where
362     ppr_fun_tail (FunTy ty1 ty2) = (arrow <+> ppr_type FunPrec ty1) : ppr_fun_tail ty2
363     ppr_fun_tail other_ty        = [arrow <+> pprType other_ty]
364
365 ppr_forall_type :: Prec -> Type -> SDoc
366 ppr_forall_type p ty
367   = maybeParen p FunPrec $
368     sep [pprForAll tvs, pprThetaArrow ctxt, pprType tau]
369   where
370     (tvs,  rho) = split1 [] ty
371     (ctxt, tau) = split2 [] rho
372
373     split1 tvs (ForAllTy tv ty)        = split1 (tv:tvs) ty
374     split1 tvs (NoteTy (FTVNote _) ty) = split1 tvs ty
375     split1 tvs ty                      = (reverse tvs, ty)
376  
377     split2 ps (NoteTy (FTVNote _) arg   -- Rather a disgusting case
378                `FunTy` res)           = split2 ps (arg `FunTy` res)
379     split2 ps (PredTy p `FunTy` ty)   = split2 (p:ps) ty
380     split2 ps (NoteTy (FTVNote _) ty) = split2 ps ty
381     split2 ps ty                      = (reverse ps, ty)
382
383 ppr_tc_app :: Prec -> TyCon -> [Type] -> SDoc
384 ppr_tc_app p tc [] 
385   = ppr_tc tc
386 ppr_tc_app p tc [ty] 
387   | tc `hasKey` listTyConKey = brackets (pprType ty)
388   | tc `hasKey` parrTyConKey = ptext SLIT("[:") <> pprType ty <> ptext SLIT(":]")
389 ppr_tc_app p tc tys
390   | isTupleTyCon tc && tyConArity tc == length tys
391   = tupleParens (tupleTyConBoxity tc) (sep (punctuate comma (map pprType tys)))
392   | otherwise
393   = maybeParen p TyConPrec $
394     ppr_tc tc <+> sep (map (ppr_type TyConPrec) tys)
395
396 ppr_tc :: TyCon -> SDoc
397 ppr_tc tc
398   | isNewTyCon tc = ifPprDebug (if isRecursiveTyCon tc 
399                                 then ptext SLIT("<recnt>")
400                                 else ptext SLIT("<nt>")
401                     ) <> ppr tc
402   | otherwise = ppr tc
403                                
404 -------------------
405 pprForAll []  = empty
406 pprForAll tvs = ptext SLIT("forall") <+> sep (map pprTvBndr tvs) <> dot
407
408 pprTvBndr tv | isLiftedTypeKind kind = ppr tv
409              | otherwise             = parens (ppr tv <+> dcolon <+> pprKind kind)
410              where
411                kind = tyVarKind tv
412 \end{code}
413