TyCon.lhs 31.6 KB
Newer Older
1
%
2
% (c) The University of Glasgow 2006
3
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4
%
5
6

The @TyCon@ datatype
7
8
9

\begin{code}
module TyCon(
10
	TyCon, FieldLabel,
11

12
13
14
	PrimRep(..),
	tyConPrimRep,

15
	AlgTyConRhs(..), visibleDataCons, 
16
        TyConParent(..), 
17
	SynTyConRhs(..),
18

19
	isFunTyCon, isUnLiftedTyCon, isProductTyCon, 
20
21
	isAlgTyCon, isDataTyCon, isNewTyCon, isClosedNewTyCon, isSynTyCon,
	isClosedSynTyCon, isPrimTyCon, 
22
23
	isEnumerationTyCon, isGadtSyntaxTyCon, isOpenTyCon,
	assocTyConArgPoss_maybe, isTyConAssoc, setTyConArgPoss,
24
	isTupleTyCon, isUnboxedTupleTyCon, isBoxedTupleTyCon, tupleTyConBoxity,
25
	isRecursiveTyCon, newTyConRep, newTyConRhs, newTyConCo_maybe,
26
27
	isHiBootTyCon, isSuperKindTyCon,
        isCoercionTyCon_maybe, isCoercionTyCon,
28
        isImplicitTyCon,
29

30
	tcExpandTyCon_maybe, coreExpandTyCon_maybe,
31

32
33
	makeTyConAbstract, isAbstractTyCon,

34
35
	mkForeignTyCon, isForeignTyCon,

36
	mkAlgTyCon,
37
	mkClassTyCon,
38
39
	mkFunTyCon,
	mkPrimTyCon,
40
	mkVoidPrimTyCon,
41
	mkLiftedPrimTyCon,
42
43
	mkTupleTyCon,
	mkSynTyCon,
44
45
        mkSuperKindTyCon,
        mkCoercionTyCon,
46

47
	tyConName,
48
49
50
	tyConKind,
	tyConUnique,
	tyConTyVars,
51
	algTyConRhs, tyConDataCons, tyConDataCons_maybe, tyConFamilySize,
52
	tyConSelIds,
53
	tyConStupidTheta,
54
	tyConArity,
55
	isClassTyCon, tyConClass_maybe,
56
	isFamInstTyCon, tyConFamInst_maybe, tyConFamilyCoercion_maybe,
57
	synTyConDefn, synTyConRhs, synTyConType, synTyConResKind,
58
	tyConExtName,		-- External name for foreign types
59

60
61
        maybeTyConSingleCon,

62
	-- Generics
63
        tyConHasGenerics
64
65
) where

66
#include "HsVersions.h"
67

68
import {-# SOURCE #-} TypeRep ( Kind, Type, PredType )
69
import {-# SOURCE #-} DataCon ( DataCon, isVanillaDataCon )
70

71
72
73
74
75
76
import Var
import Class
import BasicTypes
import Name
import PrelNames
import Maybes
77
import Outputable
rrt's avatar
rrt committed
78
import FastString
79
80
\end{code}

81
82
83
84
85
86
%************************************************************************
%*									*
\subsection{The data type}
%*									*
%************************************************************************

87
88
\begin{code}
data TyCon
89
90
91
92
93
94
95
96
  = FunTyCon {
	tyConUnique :: Unique,
	tyConName   :: Name,
	tyConKind   :: Kind,
	tyConArity  :: Arity
    }


97
  | AlgTyCon {		-- Data type, and newtype decls.
98
99
100
101
102
			-- All lifted, all boxed
	tyConUnique :: Unique,
	tyConName   :: Name,
	tyConKind   :: Kind,
	tyConArity  :: Arity,
103

104
105
106
	tyConTyVars :: [TyVar],		-- Scopes over (a) the algTcStupidTheta
					--	       (b) the cached types in
					--		   algTyConRhs.NewTyCon
107
108
					--	       (c) the family instance
					--		   types if present
109
					-- But not over the data constructors
110

111
	algTcSelIds :: [Id],  		-- Its record selectors (empty if none)
112

113
114
115
116
	algTcGadtSyntax  :: Bool,	-- True <=> the data type was declared using GADT syntax
					-- That doesn't mean it's a true GADT; only that the "where"
					-- 	form was used. This field is used only to guide
					--	pretty-printinng
117
118
119
	algTcStupidTheta :: [PredType],	-- The "stupid theta" for the data type
					-- (always empty for GADTs)

120
	algTcRhs :: AlgTyConRhs,	-- Data constructors in here
121

122
123
	algTcRec :: RecFlag,		-- Tells whether the data type is part
					-- of a mutually-recursive group or not
124

125
	hasGenerics :: Bool,		-- True <=> generic to/from functions are available
126
					-- (in the exports of the data type's source module)
127

128
	algTcParent :: TyConParent	-- Gives the class or family tycon for
129
130
					-- derived tycons representing classes
					-- or family instances, respectively.
131
132
    }

133
134
135
136
137
138
139
140
141
142
143
144
  | TupleTyCon {
	tyConUnique :: Unique,
	tyConName   :: Name,
	tyConKind   :: Kind,
	tyConArity  :: Arity,
	tyConBoxed  :: Boxity,
	tyConTyVars :: [TyVar],
	dataCon     :: DataCon,
	hasGenerics :: Bool
    }

  | SynTyCon {
145
146
147
148
149
150
	tyConUnique  :: Unique,
	tyConName    :: Name,
	tyConKind    :: Kind,
	tyConArity   :: Arity,

	tyConTyVars  :: [TyVar],	-- Bound tyvars
151

152
153
154
155
156
157
	synTcRhs     :: SynTyConRhs,	-- Expanded type in here

        synTcParent  :: TyConParent     -- Gives the family tycon of
                                        -- representation tycons of family
                                        -- instances

158
159
    }

160
161
  | PrimTyCon {			-- Primitive types; cannot be defined in Haskell
				-- Now includes foreign-imported types
162
                                -- Also includes Kinds
163
164
165
	tyConUnique   :: Unique,
	tyConName     :: Name,
	tyConKind     :: Kind,
166
167
	tyConArity    :: Arity,		-- SLPJ Oct06: I'm not sure what the significance
					--	       of the arity of a primtycon is!
168
169
170
171

	primTyConRep  :: PrimRep,
			-- Many primitive tycons are unboxed, but some are
			-- boxed (represented by pointers). The CgRep tells.
172

173
174
	isUnLifted   :: Bool,		-- Most primitive tycons are unlifted, 
					-- but foreign-imported ones may not be
175
	tyConExtName :: Maybe FastString	-- Just xx for foreign-imported types
176
177
    }

178
179
  | CoercionTyCon {	-- E.g. (:=:), sym, trans, left, right
			-- INVARIANT: coercions are always fully applied
180
	tyConUnique :: Unique,
181
        tyConName   :: Name,
182
	tyConArity  :: Arity,
183
184
185
186
	coKindFun   :: [Type] -> (Type,Type)
    }		-- INVARAINT: coKindFun is always applied to exactly 'arity' args
		-- E.g. for trans (c1 :: ta=tb) (c2 :: tb=tc), the coKindFun returns 
		--	the kind as a pair of types: (ta,tc)
187
188
189
190
191
	
  | SuperKindTyCon {    -- Super Kinds, TY (box) and CO (diamond).
			-- They have no kind; and arity zero
        tyConUnique :: Unique,
        tyConName   :: Name
192
193
    }

194
195
type FieldLabel = Name

196
197
-- Right hand sides of type constructors for algebraic types
--
198
data AlgTyConRhs
199

200
201
202
203
204
205
206
  -- We know nothing about this data type, except that it's represented by a
  -- pointer.  Used when we export a data type abstractly into an hi file.
  --
  = AbstractTyCon

  -- The constructor represents an open family without a fixed right hand
  -- side.  Additional instances can appear at any time.
207
208
209
210
211
212
213
  -- 
  -- These are introduced by either a top level decl:
  --	data T a :: *
  -- or an assoicated data type decl, in a class decl:
  --    class C a b where
  --	  data T b :: *

214
215
216
  | OpenTyCon {

      otArgPoss   :: Maybe [Int],  
217
218
219
220
221
	-- Nothing <=> top-level indexed type family
	-- Just ns <=> associated (not toplevel) family
	--   In the latter case, for each tyvar in the AT decl, 'ns' gives the
	--   position of that tyvar in the class argument list (starting from 0).
	--   NB: Length is less than tyConArity iff higher kind signature.
222
223
224
225
226
	
      otIsNewtype :: Bool	     
        -- is a newtype (rather than data type)?

    }
227

228
229
230
  | DataTyCon {
	data_cons :: [DataCon],
			-- The constructors; can be empty if the user declares
231
			--   the type to have no constructors
232
			-- INVARIANT: Kept in order of increasing tag
233
			--	  (see the tag assignment in DataCon.mkDataCon)
234
235
236
237
238
	is_enum :: Bool 	-- Cached: True <=> an enumeration type
    }			--	   Includes data types with no constructors.

  | NewTyCon {
	data_con :: DataCon,	-- The unique constructor; it has no existentials
239

240
241
	nt_rhs :: Type,		-- Cached: the argument type of the constructor
				--  = the representation type of the tycon
242
243
				-- The free tyvars of this type are the tyConTyVars
      
244
        nt_co :: Maybe TyCon,   -- The coercion used to create the newtype
245
                                -- from the representation
246
                                -- optional for non-recursive newtypes
247
				-- See Note [Newtype coercions]
248

249
250
251
252
253
254
255
256
	nt_etad_rhs :: ([TyVar], Type) ,
			-- The same again, but this time eta-reduced
			-- hence the [TyVar] which may be shorter than the declared 
			-- arity of the TyCon.  See Note [Newtype eta]

	nt_rep :: Type	-- Cached: the *ultimate* representation type
			-- By 'ultimate' I mean that the top-level constructor
			-- of the rep type is not itself a newtype or type synonym.
257
258
259
			-- The rep type isn't entirely simple:
			--  for a recursive newtype we pick () as the rep type
			--	newtype T = MkT T
260
261
262
			-- 
			-- This one does not need to be eta reduced; hence its
			-- free type variables are conveniently tyConTyVars
263
			-- Thus:
264
			-- 	newtype T a = MkT [(a,Int)]
265
			-- The rep type is [(a,Int)]
266
267
268
			-- NB: the rep type isn't necessarily the original RHS of the
			--     newtype decl, because the rep type looks through other
    }			--     newtypes.
269

270
visibleDataCons :: AlgTyConRhs -> [DataCon]
271
visibleDataCons AbstractTyCon      	      = []
272
visibleDataCons OpenTyCon {}		      = []
273
274
visibleDataCons (DataTyCon{ data_cons = cs }) = cs
visibleDataCons (NewTyCon{ data_con = c })    = [c]
275

276
277
-- Both type classes as well as family instances imply implicit
-- type constructors.  These implicit type constructors refer to their parent
278
-- structure (ie, the class or family from which they derive) using a type of
279
280
-- the following form.  We use `TyConParent' for both algebraic and synonym 
-- types, but the variant `ClassTyCon' will only be used by algebraic tycons.
281

282
data TyConParent 
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
283
284
285
  = NoParentTyCon	-- An ordinary type constructor has no parent.

  | ClassTyCon      	-- Type constructors representing a class dictionary.
286
	Class		-- INVARIANT: the classTyCon of this Class is the current tycon
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
287
288
289

  | FamilyTyCon		-- Type constructors representing an instance of a type
	TyCon		--   The type family
290
	[Type]		--   Instance types; free variables are the tyConTyVars
291
292
293
			--	of the current TyCon (not the family one)
			--	INVARIANT: the number of types matches the arity 
			--		   of the family tycon
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
294
295
296
	TyCon		--   A CoercionTyCon identifying the representation 
			--     type with the type instance family.  
			--	c.f. Note [Newtype coercions]
297
298

	--
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
299
300
	-- E.g.  data intance T [a] = ...
	-- gives a representation tycon:
301
302
303
	--	data :R7T a = ...
	-- 	axiom co a :: T [a] ~ :R7T a
	-- with :R7T's algTcParent = FamilyTyCon T [a] co
304

305
306
307
308
309
310
okParent :: Name -> TyConParent -> Bool	-- Checks invariants
okParent tc_name NoParentTyCon    		= True
okParent tc_name (ClassTyCon cls) 		= tyConName (classTyCon cls) == tc_name
okParent tc_name (FamilyTyCon fam_tc tys co_tc) = tyConArity fam_tc == length tys

--------------------
311
data SynTyConRhs
312
313
314
315
316
317
318
319
  = OpenSynTyCon Kind	        -- Type family: *result* kind given
		 (Maybe [Int])  -- for associated families: for each tyvars in
				-- the AT decl, gives the position of that
				-- tyvar in the class argument list (starting
				-- from 0). 
				-- NB: Length is less than tyConArity
				--     if higher kind signature.

320
321
  | SynonymTyCon Type   -- Mentioning head type vars.  Acts as a template for
			--  the expansion when the tycon is applied to some
322
			--  types.
323
324
\end{code}

325
326
327
328
329
330
331
Note [Newtype coercions]
~~~~~~~~~~~~~~~~~~~~~~~~

The NewTyCon field nt_co is a a TyCon (a coercion constructor in fact)
which is used for coercing from the representation type of the
newtype, to the newtype itself. For example,

332
   newtype T a = MkT (a -> a)
333

334
335
336
337
338
339
340
341
342
343
344
345
the NewTyCon for T will contain nt_co = CoT where CoT t : T t :=: t ->
t.  This TyCon is a CoercionTyCon, so it does not have a kind on its
own; it basically has its own typing rule for the fully-applied
version.  If the newtype T has k type variables then CoT has arity at
most k.  In the case that the right hand side is a type application
ending with the same type variables as the left hand side, we
"eta-contract" the coercion.  So if we had

   newtype S a = MkT [a]

then we would generate the arity 0 coercion CoS : S :=: [].  The
primary reason we do this is to make newtype deriving cleaner.
346

347
In the paper we'd write
348
	axiom CoT : (forall t. T t) :=: (forall t. [t])
349
350
351
352
and then when we used CoT at a particular type, s, we'd say
	CoT @ s
which encodes as (TyConApp instCoercionTyCon [TyConApp CoT [], s])

simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
353
But in GHC we instead make CoT into a new piece of type syntax, CoercionTyCon,
354
355
(like instCoercionTyCon, symCoercionTyCon etc), which must always
be saturated, but which encodes as
356
	TyConApp CoT [s]
357
358
In the vocabulary of the paper it's as if we had axiom declarations
like
359
	axiom CoT t :  T t :=: [t]
360

361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
Note [Newtype eta]
~~~~~~~~~~~~~~~~~~
Consider
	newtype Parser m a = MkParser (Foogle m a)
Are these two types equal (to Core)?
	Monad (Parser m) 
	Monad (Foogle m)
Well, yes.  But to see that easily we eta-reduce the RHS type of
Parser, in this case to ([], Froogle), so that even unsaturated applications
of Parser will work right.  This eta reduction is done when the type 
constructor is built, and cached in NewTyCon.  The cached field is
only used in coreExpandTyCon_maybe.
 
Here's an example that I think showed up in practice
Source code:
	newtype T a = MkT [a]
	newtype Foo m = MkFoo (forall a. m a -> Int)

	w1 :: Foo []
	w1 = ...
	
	w2 :: Foo T
	w2 = MkFoo (\(MkT x) -> case w1 of MkFoo f -> f x)

After desugaring, and discading the data constructors for the newtypes,
we get:
	w2 :: Foo T
	w2 = w1
And now Lint complains unless Foo T == Foo [], and that requires T==[]


392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
Note [Indexed data types] (aka data type families)
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
   See also Note [Wrappers for data instance tycons] in MkId.lhs

Consider
	data family T a

	data instance T (b,c) where
	  T1 :: b -> c -> T (b,c)

Then
  * T is the "family TyCon"

  * We make "representation TyCon" :R1T, thus:
	data :R1T b c where
	  T1 ::	forall b c. b -> c -> :R1T b c

  * It has a top-level coercion connecting it to the family TyCon

	axiom :Co:R1T b c : T (b,c) ~ :R1T b c

  * The data contructor T1 has a wrapper (which is what the source-level
    "T1" invokes):

	$WT1 :: forall b c. b -> c -> T (b,c)
	$WT1 b c (x::b) (y::c) = T1 b c x y `cast` sym (:Co:R1T b c)

  * The representation TyCon :R1T has an AlgTyConParent of

	FamilyTyCon T [(b,c)] :Co:R1T



425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
%************************************************************************
%*									*
\subsection{PrimRep}
%*									*
%************************************************************************

A PrimRep is an abstraction of a type.  It contains information that
the code generator needs in order to pass arguments, return results,
and store values of this type.

A PrimRep is somewhat similar to a CgRep (see codeGen/SMRep) and a
MachRep (see cmm/MachOp), although each of these types has a distinct
and clearly defined purpose:

  - A PrimRep is a CgRep + information about signedness + information
    about primitive pointers (AddrRep).  Signedness and primitive
    pointers are required when passing a primitive type to a foreign
    function, but aren't needed for call/return conventions of Haskell
    functions.

  - A MachRep is a basic machine type (non-void, doesn't contain
    information on pointerhood or signedness, but contains some
    reps that don't have corresponding Haskell types).

\begin{code}
data PrimRep
  = VoidRep
  | PtrRep
  | IntRep		-- signed, word-sized
  | WordRep		-- unsinged, word-sized
  | Int64Rep		-- signed, 64 bit (32-bit words only)
  | Word64Rep		-- unsigned, 64 bit (32-bit words only)
  | AddrRep		-- a pointer, but not to a Haskell value
  | FloatRep
  | DoubleRep
\end{code}
461

462
463
464
465
466
%************************************************************************
%*									*
\subsection{TyCon Construction}
%*									*
%************************************************************************
467

468
469
470
471
472
Note: the TyCon constructors all take a Kind as one argument, even though
they could, in principle, work out their Kind from their other arguments.
But to do so they need functions from Types, and that makes a nasty
module mutual-recursion.  And they aren't called from many places.
So we compromise, and move their Kind calculation to the call site.
473

474
\begin{code}
475
mkFunTyCon :: Name -> Kind -> TyCon
476
477
478
479
480
481
482
mkFunTyCon name kind 
  = FunTyCon { 
	tyConUnique = nameUnique name,
	tyConName   = name,
	tyConKind   = kind,
	tyConArity  = 2
    }
483
484
485
486

-- This is the making of a TyCon. Just the same as the old mkAlgTyCon,
-- but now you also have to pass in the generic information about the type
-- constructor - you can get hold of it easily (see Generics module)
487
mkAlgTyCon name kind tyvars stupid rhs sel_ids parent is_rec gen_info gadt_syn
488
  = AlgTyCon {	
489
490
491
492
493
	tyConName 	 = name,
	tyConUnique	 = nameUnique name,
	tyConKind	 = kind,
	tyConArity	 = length tyvars,
	tyConTyVars	 = tyvars,
494
	algTcStupidTheta = stupid,
495
	algTcRhs         = rhs,
496
	algTcSelIds	 = sel_ids,
497
	algTcParent	 = ASSERT( okParent name parent ) parent,
498
	algTcRec	 = is_rec,
499
	algTcGadtSyntax  = gadt_syn,
500
	hasGenerics = gen_info
501
502
    }

503
504
mkClassTyCon name kind tyvars rhs clas is_rec =
  mkAlgTyCon name kind tyvars [] rhs [] (ClassTyCon clas) is_rec False False
505

506
mkTupleTyCon name kind arity tyvars con boxed gen_info
507
508
509
510
511
512
513
  = TupleTyCon {
	tyConUnique = nameUnique name,
	tyConName = name,
	tyConKind = kind,
	tyConArity = arity,
	tyConBoxed = boxed,
	tyConTyVars = tyvars,
514
	dataCon = con,
515
	hasGenerics = gen_info
516
517
    }

518
-- Foreign-imported (.NET) type constructors are represented
rrt's avatar
rrt committed
519
520
521
-- as primitive, but *lifted*, TyCons for now. They are lifted
-- because the Haskell type T representing the (foreign) .NET
-- type T is actually implemented (in ILX) as a thunk<T>
522
mkForeignTyCon name ext_name kind arity
523
  = PrimTyCon {
524
525
526
527
	tyConName    = name,
	tyConUnique  = nameUnique name,
	tyConKind    = kind,
	tyConArity   = arity,
528
	primTyConRep = PtrRep, -- they all do
rrt's avatar
rrt committed
529
530
	isUnLifted   = False,
	tyConExtName = ext_name
531
532
533
    }


534
-- most Prim tycons are lifted
535
536
mkPrimTyCon name kind arity rep
  = mkPrimTyCon' name kind arity rep True  
537

538
539
mkVoidPrimTyCon name kind arity 
  = mkPrimTyCon' name kind arity VoidRep True  
540

541
-- but RealWorld is lifted
542
543
mkLiftedPrimTyCon name kind arity rep
  = mkPrimTyCon' name kind arity rep False
544

545
mkPrimTyCon' name kind arity rep is_unlifted
546
547
548
549
550
551
  = PrimTyCon {
	tyConName    = name,
	tyConUnique  = nameUnique name,
	tyConKind    = kind,
	tyConArity   = arity,
	primTyConRep = rep,
552
	isUnLifted   = is_unlifted,
rrt's avatar
rrt committed
553
	tyConExtName = Nothing
554
555
    }

556
mkSynTyCon name kind tyvars rhs parent
557
558
559
560
  = SynTyCon {	
	tyConName = name,
	tyConUnique = nameUnique name,
	tyConKind = kind,
561
	tyConArity = length tyvars,
562
	tyConTyVars = tyvars,
563
564
	synTcRhs = rhs,
        synTcParent = parent
565
    }
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580

mkCoercionTyCon name arity kindRule
  = CoercionTyCon {
        tyConName = name,
        tyConUnique = nameUnique name,
        tyConArity = arity,
        coKindFun = kindRule
    }

-- Super kinds always have arity zero
mkSuperKindTyCon name
  = SuperKindTyCon {
        tyConName = name,
        tyConUnique = nameUnique name
  }
581
\end{code}
582

583
\begin{code}
584
isFunTyCon :: TyCon -> Bool
585
586
isFunTyCon (FunTyCon {}) = True
isFunTyCon _             = False
587

588
isAbstractTyCon :: TyCon -> Bool
589
isAbstractTyCon (AlgTyCon { algTcRhs = AbstractTyCon }) = True
590
591
isAbstractTyCon _ = False

592
593
594
595
makeTyConAbstract :: TyCon -> TyCon
makeTyConAbstract tc@(AlgTyCon {}) = tc { algTcRhs = AbstractTyCon }
makeTyConAbstract tc = pprPanic "makeTyConAbstract" (ppr tc)

596
isPrimTyCon :: TyCon -> Bool
597
598
isPrimTyCon (PrimTyCon {}) = True
isPrimTyCon _              = False
599

600
isUnLiftedTyCon :: TyCon -> Bool
601
602
603
isUnLiftedTyCon (PrimTyCon  {isUnLifted = is_unlifted}) = is_unlifted
isUnLiftedTyCon (TupleTyCon {tyConBoxed = boxity})      = not (isBoxed boxity)
isUnLiftedTyCon _    				        = False
604

sof's avatar
sof committed
605
-- isAlgTyCon returns True for both @data@ and @newtype@
606
isAlgTyCon :: TyCon -> Bool
607
608
609
isAlgTyCon (AlgTyCon {})   = True
isAlgTyCon (TupleTyCon {}) = True
isAlgTyCon other 	   = False
sof's avatar
sof committed
610

611
isDataTyCon :: TyCon -> Bool
612
613
-- isDataTyCon returns True for data types that are definitely
-- represented by heap-allocated constructors.
614
615
616
617
618
-- These are srcutinised by Core-level @case@ expressions, and they
-- get info tables allocated for them.
--	True for all @data@ types
--	False for newtypes
--		  unboxed tuples
619
620
621
622
623
--		  type families
-- 
-- NB: for a data type family, T, only the *instance* tycons are
--     get an info table etc.  The family tycon does not.
--     Hence False for OpenTyCon
624
isDataTyCon tc@(AlgTyCon {algTcRhs = rhs})  
625
  = case rhs of
626
        OpenTyCon {}  -> False
627
628
	DataTyCon {}  -> True
	NewTyCon {}   -> False
629
	AbstractTyCon -> False	 -- We don't know, so return False
630
isDataTyCon (TupleTyCon {tyConBoxed = boxity}) = isBoxed boxity
631
isDataTyCon other = False
632

633
isNewTyCon :: TyCon -> Bool
634
635
636
637
638
639
isNewTyCon (AlgTyCon {algTcRhs = rhs}) = 
  case rhs of
    OpenTyCon {} -> otIsNewtype rhs
    NewTyCon {}  -> True
    _	         -> False
isNewTyCon other		       = False
640

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
641
642
643
644
645
646
647
648
-- This is an important refinement as typical newtype optimisations do *not*
-- hold for newtype families.  Why?  Given a type `T a', if T is a newtype
-- family, there is no unique right hand side by which `T a' can be replaced
-- by a cast.
--
isClosedNewTyCon :: TyCon -> Bool
isClosedNewTyCon tycon = isNewTyCon tycon && not (isOpenTyCon tycon)

649
isProductTyCon :: TyCon -> Bool
650
651
-- A "product" tycon
--	has *one* constructor, 
652
--	is *not* existential
653
-- but
654
--	may be  DataType, NewType
655
656
-- 	may be  unboxed or not, 
--	may be  recursive or not
657
-- 
658
isProductTyCon tc@(AlgTyCon {}) = case algTcRhs tc of
659
660
661
662
				    DataTyCon{ data_cons = [data_con] } 
						-> isVanillaDataCon data_con
				    NewTyCon {}	-> True
				    other	-> False
663
664
isProductTyCon (TupleTyCon {})  = True   
isProductTyCon other		= False
665

666
isSynTyCon :: TyCon -> Bool
667
668
isSynTyCon (SynTyCon {}) = True
isSynTyCon _		 = False
669

670
671
672
673
674
675
676
-- As for newtypes, it is in some contexts important to distinguish between
-- closed synonyms and synonym families, as synonym families have no unique
-- right hand side to which a synonym family application can expand.
--
isClosedSynTyCon :: TyCon -> Bool
isClosedSynTyCon tycon = isSynTyCon tycon && not (isOpenTyCon tycon)

677
678
679
680
isGadtSyntaxTyCon :: TyCon -> Bool
isGadtSyntaxTyCon (AlgTyCon { algTcGadtSyntax = res }) = res
isGadtSyntaxTyCon other				       = False

681
isEnumerationTyCon :: TyCon -> Bool
682
683
isEnumerationTyCon (AlgTyCon {algTcRhs = DataTyCon { is_enum = res }}) = res
isEnumerationTyCon other				       	       = False
684

685
isOpenTyCon :: TyCon -> Bool
686
687
688
isOpenTyCon (SynTyCon {synTcRhs = OpenSynTyCon _ _}) = True
isOpenTyCon (AlgTyCon {algTcRhs = OpenTyCon {}    }) = True
isOpenTyCon _					     = False
689

690
assocTyConArgPoss_maybe :: TyCon -> Maybe [Int]
691
692
693
694
assocTyConArgPoss_maybe (AlgTyCon { 
			   algTcRhs = OpenTyCon {otArgPoss = poss}})  = poss
assocTyConArgPoss_maybe (SynTyCon { synTcRhs = OpenSynTyCon _ poss }) = poss
assocTyConArgPoss_maybe _ = Nothing
695
696
697

isTyConAssoc :: TyCon -> Bool
isTyConAssoc = isJust . assocTyConArgPoss_maybe
698

699
setTyConArgPoss :: TyCon -> [Int] -> TyCon
700
701
702
703
setTyConArgPoss tc@(AlgTyCon { algTcRhs = rhs })               poss = 
  tc { algTcRhs = rhs {otArgPoss = Just poss} }
setTyConArgPoss tc@(SynTyCon { synTcRhs = OpenSynTyCon ki _ }) poss = 
  tc { synTcRhs = OpenSynTyCon ki (Just poss) }
704
setTyConArgPoss tc _ = pprPanic "setTyConArgPoss" (ppr tc)
705

706
isTupleTyCon :: TyCon -> Bool
707
708
709
-- The unit tycon didn't used to be classed as a tuple tycon
-- but I thought that was silly so I've undone it
-- If it can't be for some reason, it should be a AlgTyCon
710
711
712
713
714
--
-- NB: when compiling Data.Tuple, the tycons won't reply True to
-- isTupleTyCon, becuase they are built as AlgTyCons.  However they
-- get spat into the interface file as tuple tycons, so I don't think
-- it matters.
715
716
isTupleTyCon (TupleTyCon {}) = True
isTupleTyCon other 	     = False
717

718
isUnboxedTupleTyCon :: TyCon -> Bool
719
isUnboxedTupleTyCon (TupleTyCon {tyConBoxed = boxity}) = not (isBoxed boxity)
720
isUnboxedTupleTyCon other = False
721

722
isBoxedTupleTyCon :: TyCon -> Bool
723
724
725
726
727
isBoxedTupleTyCon (TupleTyCon {tyConBoxed = boxity}) = isBoxed boxity
isBoxedTupleTyCon other = False

tupleTyConBoxity tc = tyConBoxed tc

728
isRecursiveTyCon :: TyCon -> Bool
729
isRecursiveTyCon (AlgTyCon {algTcRec = Recursive}) = True
730
isRecursiveTyCon other				      = False
731

732
733
isHiBootTyCon :: TyCon -> Bool
-- Used for knot-tying in hi-boot files
734
735
isHiBootTyCon (AlgTyCon {algTcRhs = AbstractTyCon}) = True
isHiBootTyCon other			            = False
736

737
isForeignTyCon :: TyCon -> Bool
738
-- isForeignTyCon identifies foreign-imported type constructors
739
740
isForeignTyCon (PrimTyCon {tyConExtName = Just _}) = True
isForeignTyCon other				   = False
741
742
743
744
745

isSuperKindTyCon :: TyCon -> Bool
isSuperKindTyCon (SuperKindTyCon {}) = True
isSuperKindTyCon other               = False

746
isCoercionTyCon_maybe :: TyCon -> Maybe (Arity, [Type] -> (Type,Type))
747
748
749
750
isCoercionTyCon_maybe (CoercionTyCon {tyConArity = ar, coKindFun = rule}) 
  = Just (ar, rule)
isCoercionTyCon_maybe other = Nothing

751
isCoercionTyCon :: TyCon -> Bool
752
753
isCoercionTyCon (CoercionTyCon {}) = True
isCoercionTyCon other              = False
754

755
756
757
758
759
760
761
762
763
764
765
-- Identifies implicit tycons that, in particular, do not go into interface
-- files (because they are implicitly reconstructed when the interface is
-- read).
--
-- Note that 
--
-- * associated families are implicit, as they are re-constructed from
--   the class declaration in which they reside, and 
-- * family instances are *not* implicit as they represent the instance body
--   (similar to a dfun does that for a class instance).
--
766
isImplicitTyCon :: TyCon -> Bool
767
768
769
770
771
772
isImplicitTyCon tycon | isTyConAssoc tycon           = True
		      | isSynTyCon tycon	     = False
		      | isAlgTyCon tycon	     = isClassTyCon tycon ||
						       isTupleTyCon tycon
isImplicitTyCon _other                               = True
        -- catches: FunTyCon, PrimTyCon, 
773
        -- CoercionTyCon, SuperKindTyCon
774
775
\end{code}

776
777
778
779
780
781
782
783
784
785
786
787
788
789

-----------------------------------------------
--	Expand type-constructor applications
-----------------------------------------------

\begin{code}
tcExpandTyCon_maybe, coreExpandTyCon_maybe 
	:: TyCon 
	-> [Type]			-- Args to tycon
	-> Maybe ([(TyVar,Type)], 	-- Substitution
		  Type,			-- Body type (not yet substituted)
		  [Type])		-- Leftover args

-- For the *typechecker* view, we expand synonyms only
790
791
tcExpandTyCon_maybe (SynTyCon {tyConTyVars = tvs, 
			       synTcRhs = SynonymTyCon rhs }) tys
792
793
794
795
   = expand tvs rhs tys
tcExpandTyCon_maybe other_tycon tys = Nothing

---------------
796
-- For the *Core* view, we expand synonyms only as well
797

798
coreExpandTyCon_maybe (AlgTyCon {algTcRec = NonRecursive,	-- Not recursive
799
         algTcRhs = NewTyCon { nt_etad_rhs = etad_rhs, nt_co = Nothing }}) tys
800
801
802
803
   = case etad_rhs of	-- Don't do this in the pattern match, lest we accidentally
			-- match the etad_rhs of a *recursive* newtype
	(tvs,rhs) -> expand tvs rhs tys

804
coreExpandTyCon_maybe tycon tys = tcExpandTyCon_maybe tycon tys
805
806


807
808
809
810
811
812
813
814
815
816
817
818
819
----------------
expand	:: [TyVar] -> Type 			-- Template
	-> [Type]				-- Args
	-> Maybe ([(TyVar,Type)], Type, [Type])	-- Expansion
expand tvs rhs tys
  = case n_tvs `compare` length tys of
	LT -> Just (tvs `zip` tys, rhs, drop n_tvs tys)
	EQ -> Just (tvs `zip` tys, rhs, [])
	GT -> Nothing
   where
     n_tvs = length tvs
\end{code}

820
\begin{code}
821
822
823
824
825
tyConHasGenerics :: TyCon -> Bool
tyConHasGenerics (AlgTyCon {hasGenerics = hg})   = hg
tyConHasGenerics (TupleTyCon {hasGenerics = hg}) = hg
tyConHasGenerics other				 = False	-- Synonyms

826
tyConDataCons :: TyCon -> [DataCon]
827
828
829
-- It's convenient for tyConDataCons to return the
-- empty list for type synonyms etc
tyConDataCons tycon = tyConDataCons_maybe tycon `orElse` []
830
831

tyConDataCons_maybe :: TyCon -> Maybe [DataCon]
832
833
834
835
tyConDataCons_maybe (AlgTyCon {algTcRhs = DataTyCon { data_cons = cons }}) = Just cons
tyConDataCons_maybe (AlgTyCon {algTcRhs = NewTyCon { data_con = con }})    = Just [con]
tyConDataCons_maybe (TupleTyCon {dataCon = con})	       		   = Just [con]
tyConDataCons_maybe other			               		   = Nothing
836

837
tyConFamilySize  :: TyCon -> Int
838
839
840
tyConFamilySize (AlgTyCon   {algTcRhs = DataTyCon {data_cons = cons}}) = 
  length cons
tyConFamilySize (AlgTyCon   {algTcRhs = NewTyCon {}})                  = 1
841
tyConFamilySize (AlgTyCon   {algTcRhs = OpenTyCon {}})                 = 0
842
tyConFamilySize (TupleTyCon {})	 		                       = 1
843
#ifdef DEBUG
844
tyConFamilySize other = pprPanic "tyConFamilySize:" (ppr other)
845
#endif
846

847
tyConSelIds :: TyCon -> [Id]
848
849
tyConSelIds (AlgTyCon {algTcSelIds = fs}) = fs
tyConSelIds other_tycon		          = []
850
851
852

algTyConRhs :: TyCon -> AlgTyConRhs
algTyConRhs (AlgTyCon {algTcRhs = rhs})  = rhs
853
algTyConRhs (TupleTyCon {dataCon = con}) = DataTyCon { data_cons = [con], is_enum = False }
854
algTyConRhs other = pprPanic "algTyConRhs" (ppr other)
855
856
857
\end{code}

\begin{code}
858
newTyConRhs :: TyCon -> ([TyVar], Type)
859
newTyConRhs (AlgTyCon {tyConTyVars = tvs, algTcRhs = NewTyCon { nt_rhs = rhs }}) = (tvs, rhs)
860
newTyConRhs tycon = pprPanic "newTyConRhs" (ppr tycon)
861

862
newTyConRep :: TyCon -> ([TyVar], Type)
863
newTyConRep (AlgTyCon {tyConTyVars = tvs, algTcRhs = NewTyCon { nt_rep = rep }}) = (tvs, rep)
864
newTyConRep tycon = pprPanic "newTyConRep" (ppr tycon)
865

866
867
868
newTyConCo_maybe :: TyCon -> Maybe TyCon
newTyConCo_maybe (AlgTyCon {algTcRhs = NewTyCon { nt_co = co }}) = co
newTyConCo_maybe _						 = Nothing
869

870
tyConPrimRep :: TyCon -> PrimRep
871
tyConPrimRep (PrimTyCon {primTyConRep = rep}) = rep
872
tyConPrimRep tc = ASSERT(not (isUnboxedTupleTyCon tc)) PtrRep
873
874
\end{code}

875
\begin{code}
876
tyConStupidTheta :: TyCon -> [PredType]
877
878
879
tyConStupidTheta (AlgTyCon {algTcStupidTheta = stupid}) = stupid
tyConStupidTheta (TupleTyCon {})			= []
tyConStupidTheta tycon = pprPanic "tyConStupidTheta" (ppr tycon)
880
881
\end{code}

882
\begin{code}
883
synTyConDefn :: TyCon -> ([TyVar], Type)
884
885
synTyConDefn (SynTyCon {tyConTyVars = tyvars, synTcRhs = SynonymTyCon ty}) 
  = (tyvars, ty)
886
887
synTyConDefn tycon = pprPanic "getSynTyConDefn" (ppr tycon)

888
889
890
891
892
893
894
895
896
897
synTyConRhs :: TyCon -> SynTyConRhs
synTyConRhs (SynTyCon {synTcRhs = rhs}) = rhs
synTyConRhs tc				= pprPanic "synTyConRhs" (ppr tc)

synTyConType :: TyCon -> Type
synTyConType tc = case synTcRhs tc of
		    SynonymTyCon t -> t
		    _		   -> pprPanic "synTyConType" (ppr tc)

synTyConResKind :: TyCon -> Kind
898
synTyConResKind (SynTyCon {synTcRhs = OpenSynTyCon kind _}) = kind
899
synTyConResKind tycon  = pprPanic "synTyConResKind" (ppr tycon)
900
901
902
\end{code}

\begin{code}
903
maybeTyConSingleCon :: TyCon -> Maybe DataCon
904
905
906
907
908
909
maybeTyConSingleCon (AlgTyCon {algTcRhs = DataTyCon {data_cons = [c] }}) = Just c
maybeTyConSingleCon (AlgTyCon {algTcRhs = NewTyCon { data_con = c }})    = Just c
maybeTyConSingleCon (AlgTyCon {})	         = Nothing
maybeTyConSingleCon (TupleTyCon {dataCon = con}) = Just con
maybeTyConSingleCon (PrimTyCon {})               = Nothing
maybeTyConSingleCon (FunTyCon {})                = Nothing  -- case at funty
910
maybeTyConSingleCon tc = pprPanic "maybeTyConSingleCon: unexpected tycon " $ ppr tc
911
912
\end{code}

913
\begin{code}
914
isClassTyCon :: TyCon -> Bool
915
916
isClassTyCon (AlgTyCon {algTcParent = ClassTyCon _}) = True
isClassTyCon other_tycon			     = False
917
918

tyConClass_maybe :: TyCon -> Maybe Class
919
tyConClass_maybe (AlgTyCon {algTcParent = ClassTyCon clas}) = Just clas
920
tyConClass_maybe other_tycon				    = Nothing
921
922

isFamInstTyCon :: TyCon -> Bool
923
isFamInstTyCon (AlgTyCon {algTcParent = FamilyTyCon _ _ _ }) = True
924
isFamInstTyCon (SynTyCon {synTcParent = FamilyTyCon _ _ _ }) = True
925
isFamInstTyCon other_tycon			             = False
926
927

tyConFamInst_maybe :: TyCon -> Maybe (TyCon, [Type])
928
tyConFamInst_maybe (AlgTyCon {algTcParent = FamilyTyCon fam instTys _}) = 
929
  Just (fam, instTys)
930
931
tyConFamInst_maybe (SynTyCon {synTcParent = FamilyTyCon fam instTys _}) = 
  Just (fam, instTys)
932
tyConFamInst_maybe other_tycon				                = 
933
934
935
  Nothing

tyConFamilyCoercion_maybe :: TyCon -> Maybe TyCon
936
tyConFamilyCoercion_maybe (AlgTyCon {algTcParent = FamilyTyCon _ _ coe}) = 
937
  Just coe
938
939
tyConFamilyCoercion_maybe (SynTyCon {synTcParent = FamilyTyCon _ _ coe}) = 
  Just coe
940
tyConFamilyCoercion_maybe other_tycon 				         = 
941
  Nothing
942
943
\end{code}

944
945
946
947
948
949
950
951
952
953
954
955
956
957

%************************************************************************
%*									*
\subsection[TyCon-instances]{Instance declarations for @TyCon@}
%*									*
%************************************************************************

@TyCon@s are compared by comparing their @Unique@s.

The strictness analyser needs @Ord@. It is a lexicographic order with
the property @(a<=b) || (b<=a)@.

\begin{code}
instance Eq TyCon where
958
959
    a == b = case (a `compare` b) of { EQ -> True;   _ -> False }
    a /= b = case (a `compare` b) of { EQ -> False;  _ -> True  }
960
961

instance Ord TyCon where
962
963
964
965
    a <= b = case (a `compare` b) of { LT -> True;  EQ -> True;  GT -> False }
    a <	 b = case (a `compare` b) of { LT -> True;  EQ -> False; GT -> False }
    a >= b = case (a `compare` b) of { LT -> False; EQ -> True;  GT -> True  }
    a >	 b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True  }
966
    compare a b = getUnique a `compare` getUnique b
967

968
instance Uniquable TyCon where
969
970
971
    getUnique tc = tyConUnique tc

instance Outputable TyCon where
972
    ppr tc  = ppr (getName tc) 
973
974
975

instance NamedThing TyCon where
    getName = tyConName
976
\end{code}